19f91b7e3SAndre Fischer#************************************************************** 29f91b7e3SAndre Fischer# 39f91b7e3SAndre Fischer# Licensed to the Apache Software Foundation (ASF) under one 49f91b7e3SAndre Fischer# or more contributor license agreements. See the NOTICE file 59f91b7e3SAndre Fischer# distributed with this work for additional information 69f91b7e3SAndre Fischer# regarding copyright ownership. The ASF licenses this file 79f91b7e3SAndre Fischer# to you under the Apache License, Version 2.0 (the 89f91b7e3SAndre Fischer# "License"); you may not use this file except in compliance 99f91b7e3SAndre Fischer# with the License. You may obtain a copy of the License at 109f91b7e3SAndre Fischer# 119f91b7e3SAndre Fischer# http://www.apache.org/licenses/LICENSE-2.0 129f91b7e3SAndre Fischer# 139f91b7e3SAndre Fischer# Unless required by applicable law or agreed to in writing, 149f91b7e3SAndre Fischer# software distributed under the License is distributed on an 159f91b7e3SAndre Fischer# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 169f91b7e3SAndre Fischer# KIND, either express or implied. See the License for the 179f91b7e3SAndre Fischer# specific language governing permissions and limitations 189f91b7e3SAndre Fischer# under the License. 199f91b7e3SAndre Fischer# 209f91b7e3SAndre Fischer#************************************************************** 219f91b7e3SAndre Fischer 229f91b7e3SAndre Fischerpackage installer::patch::Msi; 239f91b7e3SAndre Fischer 249f91b7e3SAndre Fischeruse installer::patch::MsiTable; 259f91b7e3SAndre Fischeruse installer::patch::Tools; 269f91b7e3SAndre Fischeruse installer::patch::InstallationSet; 279f91b7e3SAndre Fischer 289f91b7e3SAndre Fischeruse File::Basename; 299f91b7e3SAndre Fischeruse File::Copy; 309f91b7e3SAndre Fischer 319f91b7e3SAndre Fischeruse strict; 329f91b7e3SAndre Fischer 339f91b7e3SAndre Fischer 349f91b7e3SAndre Fischer=head1 NAME 359f91b7e3SAndre Fischer 369f91b7e3SAndre Fischer package installer::patch::Msi - Class represents a single MSI file and gives access to its tables. 379f91b7e3SAndre Fischer 389f91b7e3SAndre Fischer=cut 399f91b7e3SAndre Fischer 409f91b7e3SAndre Fischersub FindAndCreate($$$$$) 419f91b7e3SAndre Fischer{ 429f91b7e3SAndre Fischer my ($class, $version, $is_current_version, $language, $product_name) = @_; 439f91b7e3SAndre Fischer 449f91b7e3SAndre Fischer my $condensed_version = $version; 459f91b7e3SAndre Fischer $condensed_version =~ s/\.//g; 469f91b7e3SAndre Fischer 479f91b7e3SAndre Fischer # When $version is the current version we have to search the msi at a different place. 489f91b7e3SAndre Fischer my $path; 499f91b7e3SAndre Fischer my $filename; 509f91b7e3SAndre Fischer my $is_current = 0; 519f91b7e3SAndre Fischer $path = installer::patch::InstallationSet::GetUnpackedExePath( 529f91b7e3SAndre Fischer $version, 539f91b7e3SAndre Fischer $is_current_version, 5460b96b8dSAndre Fischer installer::languages::get_normalized_language($language), 559f91b7e3SAndre Fischer "msi", 569f91b7e3SAndre Fischer $product_name); 579f91b7e3SAndre Fischer 589f91b7e3SAndre Fischer # Find the msi in the path.ls . 599f91b7e3SAndre Fischer $filename = File::Spec->catfile($path, "openoffice".$condensed_version.".msi"); 609f91b7e3SAndre Fischer $is_current = $is_current_version; 619f91b7e3SAndre Fischer 629f91b7e3SAndre Fischer return $class->new($filename, $version, $is_current, $language, $product_name); 639f91b7e3SAndre Fischer} 649f91b7e3SAndre Fischer 659f91b7e3SAndre Fischer 669f91b7e3SAndre Fischer 679f91b7e3SAndre Fischer 689f91b7e3SAndre Fischer 699f91b7e3SAndre Fischer 709f91b7e3SAndre Fischer=head2 new($class, $filename, $version, $is_current_version, $language, $product_name) 719f91b7e3SAndre Fischer 72*f1e0dfd3SMatthias Seidel Create a new object of the Msi class. The values of $version, $language, and $product_name define 739f91b7e3SAndre Fischer where to look for the msi file. 749f91b7e3SAndre Fischer 759f91b7e3SAndre Fischer If construction fails then IsValid() will return false. 769f91b7e3SAndre Fischer 779f91b7e3SAndre Fischer=cut 7860b96b8dSAndre Fischer 79677600b0SAndre Fischersub new ($$;$$$$) 809f91b7e3SAndre Fischer{ 819f91b7e3SAndre Fischer my ($class, $filename, $version, $is_current_version, $language, $product_name) = @_; 829f91b7e3SAndre Fischer 839f91b7e3SAndre Fischer if ( ! -f $filename) 849f91b7e3SAndre Fischer { 859f91b7e3SAndre Fischer installer::logger::PrintError("can not find the .msi file for version %s and language %s at '%s'\n", 869f91b7e3SAndre Fischer $version, 879f91b7e3SAndre Fischer $language, 889f91b7e3SAndre Fischer $filename); 899f91b7e3SAndre Fischer return undef; 909f91b7e3SAndre Fischer } 919f91b7e3SAndre Fischer 929f91b7e3SAndre Fischer my $self = { 939f91b7e3SAndre Fischer 'filename' => $filename, 949f91b7e3SAndre Fischer 'path' => dirname($filename), 959f91b7e3SAndre Fischer 'version' => $version, 969f91b7e3SAndre Fischer 'is_current_version' => $is_current_version, 979f91b7e3SAndre Fischer 'language' => $language, 989f91b7e3SAndre Fischer 'package_format' => "msi", 999f91b7e3SAndre Fischer 'product_name' => $product_name, 1009f91b7e3SAndre Fischer 'tmpdir' => File::Temp->newdir(CLEANUP => 1), 1019f91b7e3SAndre Fischer 'is_valid' => -f $filename 1029f91b7e3SAndre Fischer }; 1039f91b7e3SAndre Fischer bless($self, $class); 1049f91b7e3SAndre Fischer 105677600b0SAndre Fischer # Fill in some missing values from the 'Properties' table. 106677600b0SAndre Fischer if ( ! (defined $version && defined $language && defined $product_name)) 107677600b0SAndre Fischer { 108677600b0SAndre Fischer my $property_table = $self->GetTable("Property"); 109677600b0SAndre Fischer 110677600b0SAndre Fischer $self->{'version'} = $property_table->GetValue("Property", "DEFINEDVERSION", "Value") 111677600b0SAndre Fischer unless defined $self->{'version'}; 112677600b0SAndre Fischer $self->{'product_name'} = $property_table->GetValue("Property", "DEFINEDPRODUCT", "Value") 113677600b0SAndre Fischer unless defined $self->{'product_name'}; 114677600b0SAndre Fischer 115677600b0SAndre Fischer my $language = $property_table->GetValue("Property", "ProductLanguage", "Value"); 116677600b0SAndre Fischer # TODO: Convert numerical language id to language name. 117677600b0SAndre Fischer $self->{'language'} = $language 118677600b0SAndre Fischer unless defined $self->{'language'}; 119677600b0SAndre Fischer } 120677600b0SAndre Fischer 1219f91b7e3SAndre Fischer return $self; 1229f91b7e3SAndre Fischer} 1239f91b7e3SAndre Fischer 1249f91b7e3SAndre Fischer 1259f91b7e3SAndre Fischer 1269f91b7e3SAndre Fischer 1279f91b7e3SAndre Fischersub IsValid ($) 1289f91b7e3SAndre Fischer{ 1299f91b7e3SAndre Fischer my ($self) = @_; 1309f91b7e3SAndre Fischer 1319f91b7e3SAndre Fischer return $self->{'is_valid'}; 1329f91b7e3SAndre Fischer} 1339f91b7e3SAndre Fischer 1349f91b7e3SAndre Fischer 1359f91b7e3SAndre Fischer 1369f91b7e3SAndre Fischer 1379f91b7e3SAndre Fischer=head2 Commit($self) 1389f91b7e3SAndre Fischer 139*f1e0dfd3SMatthias Seidel Write all modified tables back into the database. 1409f91b7e3SAndre Fischer 1419f91b7e3SAndre Fischer=cut 14260b96b8dSAndre Fischer 1439f91b7e3SAndre Fischersub Commit ($) 1449f91b7e3SAndre Fischer{ 1459f91b7e3SAndre Fischer my $self = shift; 1469f91b7e3SAndre Fischer 1479f91b7e3SAndre Fischer my @tables_to_update = (); 1489f91b7e3SAndre Fischer foreach my $table (values %{$self->{'tables'}}) 1499f91b7e3SAndre Fischer { 1509f91b7e3SAndre Fischer push @tables_to_update,$table if ($table->IsModified()); 1519f91b7e3SAndre Fischer } 1529f91b7e3SAndre Fischer 1539f91b7e3SAndre Fischer if (scalar @tables_to_update > 0) 1549f91b7e3SAndre Fischer { 1559f91b7e3SAndre Fischer $installer::logger::Info->printf("writing modified tables to database:\n"); 1569f91b7e3SAndre Fischer foreach my $table (@tables_to_update) 1579f91b7e3SAndre Fischer { 1589f91b7e3SAndre Fischer $installer::logger::Info->printf(" %s\n", $table->GetName()); 1599f91b7e3SAndre Fischer $self->PutTable($table); 1609f91b7e3SAndre Fischer } 1619f91b7e3SAndre Fischer 1629f91b7e3SAndre Fischer foreach my $table (@tables_to_update) 1639f91b7e3SAndre Fischer { 1649f91b7e3SAndre Fischer $table->UpdateTimestamp(); 1659f91b7e3SAndre Fischer $table->MarkAsUnmodified(); 1669f91b7e3SAndre Fischer } 1679f91b7e3SAndre Fischer } 1689f91b7e3SAndre Fischer} 1699f91b7e3SAndre Fischer 1709f91b7e3SAndre Fischer 1719f91b7e3SAndre Fischer 1729f91b7e3SAndre Fischer 1739f91b7e3SAndre Fischer=head2 GetTable($seld, $table_name) 1749f91b7e3SAndre Fischer 175*f1e0dfd3SMatthias Seidel Return an MsiTable object for $table_name. Table objects are kept 176*f1e0dfd3SMatthias Seidel alive for the life time of the Msi object. Therefore the second 1779f91b7e3SAndre Fischer call for the same table is very cheap. 1789f91b7e3SAndre Fischer 1799f91b7e3SAndre Fischer=cut 18060b96b8dSAndre Fischer 1819f91b7e3SAndre Fischersub GetTable ($$) 1829f91b7e3SAndre Fischer{ 1839f91b7e3SAndre Fischer my ($self, $table_name) = @_; 1849f91b7e3SAndre Fischer 1859f91b7e3SAndre Fischer my $table = $self->{'tables'}->{$table_name}; 1869f91b7e3SAndre Fischer if ( ! defined $table) 1879f91b7e3SAndre Fischer { 1889f91b7e3SAndre Fischer my $table_filename = File::Spec->catfile($self->{'tmpdir'}, $table_name .".idt"); 1899f91b7e3SAndre Fischer if ( ! -f $table_filename 1909f91b7e3SAndre Fischer || ! EnsureAYoungerThanB($table_filename, $self->{'fullname'})) 1919f91b7e3SAndre Fischer { 1929f91b7e3SAndre Fischer # Extract table from database to text file on disk. 1939f91b7e3SAndre Fischer my $truncated_table_name = length($table_name)>8 ? substr($table_name,0,8) : $table_name; 1949f91b7e3SAndre Fischer my $command = join(" ", 1959f91b7e3SAndre Fischer "msidb.exe", 1969f91b7e3SAndre Fischer "-d", installer::patch::Tools::ToEscapedWindowsPath($self->{'filename'}), 1979f91b7e3SAndre Fischer "-f", installer::patch::Tools::ToEscapedWindowsPath($self->{'tmpdir'}), 1989f91b7e3SAndre Fischer "-e", $table_name); 1999f91b7e3SAndre Fischer my $result = qx($command); 2009f91b7e3SAndre Fischer } 2019f91b7e3SAndre Fischer 2029f91b7e3SAndre Fischer # Read table into memory. 2039f91b7e3SAndre Fischer $table = new installer::patch::MsiTable($table_filename, $table_name); 2049f91b7e3SAndre Fischer $self->{'tables'}->{$table_name} = $table; 2059f91b7e3SAndre Fischer } 2069f91b7e3SAndre Fischer 2079f91b7e3SAndre Fischer return $table; 2089f91b7e3SAndre Fischer} 2099f91b7e3SAndre Fischer 2109f91b7e3SAndre Fischer 2119f91b7e3SAndre Fischer 2129f91b7e3SAndre Fischer 2139f91b7e3SAndre Fischer=head2 PutTable($self, $table) 2149f91b7e3SAndre Fischer 215*f1e0dfd3SMatthias Seidel Write the given table back to the database. 2169f91b7e3SAndre Fischer 2179f91b7e3SAndre Fischer=cut 21860b96b8dSAndre Fischer 2199f91b7e3SAndre Fischersub PutTable ($$) 2209f91b7e3SAndre Fischer{ 2219f91b7e3SAndre Fischer my ($self, $table) = @_; 2229f91b7e3SAndre Fischer 2239f91b7e3SAndre Fischer # Create text file from the current table content. 2249f91b7e3SAndre Fischer $table->WriteFile(); 2259f91b7e3SAndre Fischer 2269f91b7e3SAndre Fischer my $table_name = $table->GetName(); 2279f91b7e3SAndre Fischer 2289f91b7e3SAndre Fischer # Store table from text file into database. 2299f91b7e3SAndre Fischer my $table_filename = $table->{'filename'}; 2309f91b7e3SAndre Fischer 2319f91b7e3SAndre Fischer if (length($table_name) > 8) 2329f91b7e3SAndre Fischer { 2339f91b7e3SAndre Fischer # The file name of the table data must not be longer than 8 characters (not counting the extension). 2349f91b7e3SAndre Fischer # The name passed as argument to the -i option may be longer. 2359f91b7e3SAndre Fischer my $truncated_table_name = substr($table_name,0,8); 2369f91b7e3SAndre Fischer my $table_truncated_filename = File::Spec->catfile( 2379f91b7e3SAndre Fischer dirname($table_filename), 2389f91b7e3SAndre Fischer $truncated_table_name.".idt"); 2399f91b7e3SAndre Fischer File::Copy::copy($table_filename, $table_truncated_filename) || die("can not create table file with short name"); 2409f91b7e3SAndre Fischer } 2419f91b7e3SAndre Fischer 2429f91b7e3SAndre Fischer my $command = join(" ", 2439f91b7e3SAndre Fischer "msidb.exe", 2449f91b7e3SAndre Fischer "-d", installer::patch::Tools::ToEscapedWindowsPath($self->{'filename'}), 2459f91b7e3SAndre Fischer "-f", installer::patch::Tools::ToEscapedWindowsPath($self->{'tmpdir'}), 2469f91b7e3SAndre Fischer "-i", $table_name); 2479f91b7e3SAndre Fischer my $result = system($command); 2489f91b7e3SAndre Fischer 2499f91b7e3SAndre Fischer if ($result != 0) 2509f91b7e3SAndre Fischer { 2519f91b7e3SAndre Fischer installer::logger::PrintError("writing table '%s' back to database failed", $table_name); 2529f91b7e3SAndre Fischer # For error messages see http://msdn.microsoft.com/en-us/library/windows/desktop/aa372835%28v=vs.85%29.aspx 2539f91b7e3SAndre Fischer } 2549f91b7e3SAndre Fischer} 2559f91b7e3SAndre Fischer 2569f91b7e3SAndre Fischer 2579f91b7e3SAndre Fischer 2589f91b7e3SAndre Fischer 2599f91b7e3SAndre Fischer=head2 EnsureAYoungerThanB ($filename_a, $filename_b) 2609f91b7e3SAndre Fischer 2619f91b7e3SAndre Fischer Internal function (not a method) that compares to files according 2629f91b7e3SAndre Fischer to their last modification times (mtime). 2639f91b7e3SAndre Fischer 2649f91b7e3SAndre Fischer=cut 26560b96b8dSAndre Fischer 2669f91b7e3SAndre Fischersub EnsureAYoungerThanB ($$) 2679f91b7e3SAndre Fischer{ 2689f91b7e3SAndre Fischer my ($filename_a, $filename_b) = @_; 2699f91b7e3SAndre Fischer 2709f91b7e3SAndre Fischer die("file $filename_a does not exist") unless -f $filename_a; 2719f91b7e3SAndre Fischer die("file $filename_b does not exist") unless -f $filename_b; 2729f91b7e3SAndre Fischer 2739f91b7e3SAndre Fischer my @stat_a = stat($filename_a); 2749f91b7e3SAndre Fischer my @stat_b = stat($filename_b); 2759f91b7e3SAndre Fischer 2769f91b7e3SAndre Fischer if ($stat_a[9] <= $stat_b[9]) 2779f91b7e3SAndre Fischer { 2789f91b7e3SAndre Fischer return 0; 2799f91b7e3SAndre Fischer } 2809f91b7e3SAndre Fischer else 2819f91b7e3SAndre Fischer { 2829f91b7e3SAndre Fischer return 1; 2839f91b7e3SAndre Fischer } 2849f91b7e3SAndre Fischer} 2859f91b7e3SAndre Fischer 2869f91b7e3SAndre Fischer 2879f91b7e3SAndre Fischer 2889f91b7e3SAndre Fischer 2899f91b7e3SAndre Fischer=head2 SplitLongShortName($name) 2909f91b7e3SAndre Fischer 2919f91b7e3SAndre Fischer Split $name (typically from the 'FileName' column in the 'File' 2929f91b7e3SAndre Fischer table or 'DefaultDir' column in the 'Directory' table) at the '|' 293*f1e0dfd3SMatthias Seidel into short (8.3) and long names. If there is no '|' in $name then 2949f91b7e3SAndre Fischer $name is returned as both short and long name. 2959f91b7e3SAndre Fischer 2969f91b7e3SAndre Fischer Returns long and short name (in this order) as array. 2979f91b7e3SAndre Fischer 2989f91b7e3SAndre Fischer=cut 29960b96b8dSAndre Fischer 3009f91b7e3SAndre Fischersub SplitLongShortName ($) 3019f91b7e3SAndre Fischer{ 3029f91b7e3SAndre Fischer my ($name) = @_; 3039f91b7e3SAndre Fischer 3049f91b7e3SAndre Fischer if ($name =~ /^([^\|]*)\|(.*)$/) 3059f91b7e3SAndre Fischer { 3069f91b7e3SAndre Fischer return ($2,$1); 3079f91b7e3SAndre Fischer } 3089f91b7e3SAndre Fischer else 3099f91b7e3SAndre Fischer { 3109f91b7e3SAndre Fischer return ($name,$name); 3119f91b7e3SAndre Fischer } 3129f91b7e3SAndre Fischer} 3139f91b7e3SAndre Fischer 3149f91b7e3SAndre Fischer 3159f91b7e3SAndre Fischer 3169f91b7e3SAndre Fischer=head2 SplitTargetSourceLongShortName ($name) 3179f91b7e3SAndre Fischer 3189f91b7e3SAndre Fischer Split $name first at the ':' into target and source parts and each 319*f1e0dfd3SMatthias Seidel of those at the '|'s into long and short parts. Names that follow 3209f91b7e3SAndre Fischer this pattern come from the 'DefaultDir' column in the 'Directory' 3219f91b7e3SAndre Fischer table. 3229f91b7e3SAndre Fischer 3239f91b7e3SAndre Fischer=cut 32460b96b8dSAndre Fischer 3259f91b7e3SAndre Fischersub SplitTargetSourceLongShortName ($) 3269f91b7e3SAndre Fischer{ 3279f91b7e3SAndre Fischer my ($name) = @_; 3289f91b7e3SAndre Fischer 3299f91b7e3SAndre Fischer if ($name =~ /^([^:]*):(.*)$/) 3309f91b7e3SAndre Fischer { 3319f91b7e3SAndre Fischer return (installer::patch::Msi::SplitLongShortName($1), installer::patch::Msi::SplitLongShortName($2)); 3329f91b7e3SAndre Fischer } 3339f91b7e3SAndre Fischer else 3349f91b7e3SAndre Fischer { 3359f91b7e3SAndre Fischer my ($long,$short) = installer::patch::Msi::SplitLongShortName($name); 3369f91b7e3SAndre Fischer return ($long,$short,$long,$short); 3379f91b7e3SAndre Fischer } 3389f91b7e3SAndre Fischer} 3399f91b7e3SAndre Fischer 3409f91b7e3SAndre Fischer 341677600b0SAndre Fischer 342677600b0SAndre Fischer 343677600b0SAndre Fischersub SetupFullNames ($$); 344677600b0SAndre Fischersub SetupFullNames ($$) 345677600b0SAndre Fischer{ 346677600b0SAndre Fischer my ($item, $directory_map) = @_; 347677600b0SAndre Fischer 348677600b0SAndre Fischer # Don't process any item twice. 349677600b0SAndre Fischer return if defined $item->{'full_source_name'}; 350677600b0SAndre Fischer 351677600b0SAndre Fischer my $parent = $item->{'parent'}; 352677600b0SAndre Fischer if (defined $parent) 353677600b0SAndre Fischer { 354677600b0SAndre Fischer # Process the parent first. 355677600b0SAndre Fischer if ( ! defined $parent->{'full_source_long_name'}) 356677600b0SAndre Fischer { 357677600b0SAndre Fischer SetupFullNames($parent, $directory_map); 358677600b0SAndre Fischer } 359677600b0SAndre Fischer 360677600b0SAndre Fischer # Prepend the full names of the parent to our names. 361677600b0SAndre Fischer $item->{'full_source_long_name'} 362677600b0SAndre Fischer = $parent->{'full_source_long_name'} . "/" . $item->{'source_long_name'}; 363677600b0SAndre Fischer $item->{'full_source_short_name'} 364677600b0SAndre Fischer = $parent->{'full_source_short_name'} . "/" . $item->{'source_short_name'}; 365677600b0SAndre Fischer $item->{'full_target_long_name'} 366677600b0SAndre Fischer = $parent->{'full_target_long_name'} . "/" . $item->{'target_long_name'}; 367677600b0SAndre Fischer $item->{'full_target_short_name'} 368677600b0SAndre Fischer = $parent->{'full_target_short_name'} . "/" . $item->{'target_short_name'}; 369677600b0SAndre Fischer } 370677600b0SAndre Fischer else 371677600b0SAndre Fischer { 372677600b0SAndre Fischer # Directory has no parent => full names are the same as the name. 373677600b0SAndre Fischer $item->{'full_source_long_name'} = $item->{'source_long_name'}; 374677600b0SAndre Fischer $item->{'full_source_short_name'} = $item->{'source_short_name'}; 375677600b0SAndre Fischer $item->{'full_target_long_name'} = $item->{'target_long_name'}; 376677600b0SAndre Fischer $item->{'full_target_short_name'} = $item->{'target_short_name'}; 377677600b0SAndre Fischer } 378677600b0SAndre Fischer} 379677600b0SAndre Fischer 380677600b0SAndre Fischer 381677600b0SAndre Fischer 382677600b0SAndre Fischer 3839f91b7e3SAndre Fischer=head2 GetDirectoryMap($self) 3849f91b7e3SAndre Fischer 3859f91b7e3SAndre Fischer Return a map that maps directory unique names (column 'Directory' in table 'Directory') 3869f91b7e3SAndre Fischer to hashes that contains short and long source and target names. 3879f91b7e3SAndre Fischer 3889f91b7e3SAndre Fischer=cut 38960b96b8dSAndre Fischer 3909f91b7e3SAndre Fischersub GetDirectoryMap ($) 3919f91b7e3SAndre Fischer{ 3929f91b7e3SAndre Fischer my ($self) = @_; 3939f91b7e3SAndre Fischer 3949f91b7e3SAndre Fischer if (defined $self->{'DirectoryMap'}) 3959f91b7e3SAndre Fischer { 3969f91b7e3SAndre Fischer return $self->{'DirectoryMap'}; 3979f91b7e3SAndre Fischer } 3989f91b7e3SAndre Fischer 399677600b0SAndre Fischer # Initialize the directory map. 4009f91b7e3SAndre Fischer my $directory_table = $self->GetTable("Directory"); 401677600b0SAndre Fischer my $directory_map = (); 4029f91b7e3SAndre Fischer foreach my $row (@{$directory_table->GetAllRows()}) 4039f91b7e3SAndre Fischer { 4049f91b7e3SAndre Fischer my ($target_long_name, $target_short_name, $source_long_name, $source_short_name) 4059f91b7e3SAndre Fischer = installer::patch::Msi::SplitTargetSourceLongShortName($row->GetValue("DefaultDir")); 4069f91b7e3SAndre Fischer my $unique_name = $row->GetValue("Directory"); 407677600b0SAndre Fischer $directory_map->{$unique_name} = 4089f91b7e3SAndre Fischer { 4099f91b7e3SAndre Fischer 'unique_name' => $unique_name, 410677600b0SAndre Fischer 'parent_name' => $row->GetValue("Directory_Parent"), 4119f91b7e3SAndre Fischer 'default_dir' => $row->GetValue("DefaultDir"), 4129f91b7e3SAndre Fischer 'source_long_name' => $source_long_name, 4139f91b7e3SAndre Fischer 'source_short_name' => $source_short_name, 4149f91b7e3SAndre Fischer 'target_long_name' => $target_long_name, 4159f91b7e3SAndre Fischer 'target_short_name' => $target_short_name 4169f91b7e3SAndre Fischer }; 4179f91b7e3SAndre Fischer } 4189f91b7e3SAndre Fischer 419677600b0SAndre Fischer # Add references to parent directories. 420677600b0SAndre Fischer foreach my $item (values %$directory_map) 4219f91b7e3SAndre Fischer { 422677600b0SAndre Fischer $item->{'parent'} = $directory_map->{$item->{'parent_name'}}; 423677600b0SAndre Fischer } 4249f91b7e3SAndre Fischer 425677600b0SAndre Fischer # Set up full names for all directories. 426677600b0SAndre Fischer foreach my $item (values %$directory_map) 427677600b0SAndre Fischer { 428677600b0SAndre Fischer SetupFullNames($item, $directory_map); 4299f91b7e3SAndre Fischer } 4309f91b7e3SAndre Fischer 431677600b0SAndre Fischer # Cleanup the names. 432677600b0SAndre Fischer foreach my $item (values %$directory_map) 4339f91b7e3SAndre Fischer { 4349f91b7e3SAndre Fischer foreach my $id ( 4359f91b7e3SAndre Fischer 'full_source_long_name', 4369f91b7e3SAndre Fischer 'full_source_short_name', 4379f91b7e3SAndre Fischer 'full_target_long_name', 4389f91b7e3SAndre Fischer 'full_target_short_name') 4399f91b7e3SAndre Fischer { 4409f91b7e3SAndre Fischer $item->{$id} =~ s/\/(\.\/)+/\//g; 4419f91b7e3SAndre Fischer $item->{$id} =~ s/^SourceDir\///; 4429f91b7e3SAndre Fischer $item->{$id} =~ s/^\.$//; 4439f91b7e3SAndre Fischer } 4449f91b7e3SAndre Fischer } 4459f91b7e3SAndre Fischer 446677600b0SAndre Fischer $self->{'DirectoryMap'} = $directory_map; 4479f91b7e3SAndre Fischer return $self->{'DirectoryMap'}; 4489f91b7e3SAndre Fischer} 4499f91b7e3SAndre Fischer 4509f91b7e3SAndre Fischer 4519f91b7e3SAndre Fischer 4529f91b7e3SAndre Fischer 4539f91b7e3SAndre Fischer=head2 GetFileMap ($) 4549f91b7e3SAndre Fischer 4559f91b7e3SAndre Fischer Return a map (hash) that maps the unique name (column 'File' in 4569f91b7e3SAndre Fischer the 'File' table) to data that is associated with that file, like 4579f91b7e3SAndre Fischer the directory or component. 4589f91b7e3SAndre Fischer 4599f91b7e3SAndre Fischer The map is kept alive for the lifetime of the Msi object. All 4609f91b7e3SAndre Fischer calls but the first are cheap. 4619f91b7e3SAndre Fischer 4629f91b7e3SAndre Fischer=cut 46360b96b8dSAndre Fischer 4649f91b7e3SAndre Fischersub GetFileMap ($) 4659f91b7e3SAndre Fischer{ 4669f91b7e3SAndre Fischer my ($self) = @_; 4679f91b7e3SAndre Fischer 4689f91b7e3SAndre Fischer if (defined $self->{'FileMap'}) 4699f91b7e3SAndre Fischer { 4709f91b7e3SAndre Fischer return $self->{'FileMap'}; 4719f91b7e3SAndre Fischer } 4729f91b7e3SAndre Fischer 4739f91b7e3SAndre Fischer my $file_table = $self->GetTable("File"); 4749f91b7e3SAndre Fischer my $component_table = $self->GetTable("Component"); 4759f91b7e3SAndre Fischer my $dir_map = $self->GetDirectoryMap(); 4769f91b7e3SAndre Fischer 4779f91b7e3SAndre Fischer # Setup a map from component names to directory items. 4789f91b7e3SAndre Fischer my %component_to_directory_map = 4799f91b7e3SAndre Fischer map 4809f91b7e3SAndre Fischer {$_->GetValue('Component') => $_->GetValue('Directory_')} 4819f91b7e3SAndre Fischer @{$component_table->GetAllRows()}; 4829f91b7e3SAndre Fischer 4839f91b7e3SAndre Fischer # Finally, create the map from files to directories. 4849f91b7e3SAndre Fischer my $file_map = {}; 4859f91b7e3SAndre Fischer my $file_component_index = $file_table->GetColumnIndex("Component_"); 4869f91b7e3SAndre Fischer my $file_file_index = $file_table->GetColumnIndex("File"); 487677600b0SAndre Fischer my $file_filename_index = $file_table->GetColumnIndex("FileName"); 4889f91b7e3SAndre Fischer foreach my $file_row (@{$file_table->GetAllRows()}) 4899f91b7e3SAndre Fischer { 4909f91b7e3SAndre Fischer my $component_name = $file_row->GetValue($file_component_index); 4919f91b7e3SAndre Fischer my $directory_name = $component_to_directory_map{$component_name}; 4929f91b7e3SAndre Fischer my $unique_name = $file_row->GetValue($file_file_index); 493677600b0SAndre Fischer my $file_name = $file_row->GetValue($file_filename_index); 494677600b0SAndre Fischer my ($long_name, $short_name) = SplitLongShortName($file_name); 4959f91b7e3SAndre Fischer $file_map->{$unique_name} = { 4969f91b7e3SAndre Fischer 'directory' => $dir_map->{$directory_name}, 497677600b0SAndre Fischer 'component_name' => $component_name, 498677600b0SAndre Fischer 'file_name' => $file_name, 499677600b0SAndre Fischer 'long_name' => $long_name, 500677600b0SAndre Fischer 'short_name' => $short_name 5019f91b7e3SAndre Fischer }; 5029f91b7e3SAndre Fischer } 5039f91b7e3SAndre Fischer 5049f91b7e3SAndre Fischer $self->{'FileMap'} = $file_map; 5059f91b7e3SAndre Fischer return $file_map; 5069f91b7e3SAndre Fischer} 5079f91b7e3SAndre Fischer 5089f91b7e3SAndre Fischer 5099f91b7e3SAndre Fischer1; 510