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, 54*60b96b8dSAndre 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 729f91b7e3SAndre Fischer 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 78*60b96b8dSAndre Fischer 799f91b7e3SAndre 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 1059f91b7e3SAndre Fischer return $self; 1069f91b7e3SAndre Fischer} 1079f91b7e3SAndre Fischer 1089f91b7e3SAndre Fischer 1099f91b7e3SAndre Fischer 1109f91b7e3SAndre Fischer 1119f91b7e3SAndre Fischersub IsValid ($) 1129f91b7e3SAndre Fischer{ 1139f91b7e3SAndre Fischer my ($self) = @_; 1149f91b7e3SAndre Fischer 1159f91b7e3SAndre Fischer return $self->{'is_valid'}; 1169f91b7e3SAndre Fischer} 1179f91b7e3SAndre Fischer 1189f91b7e3SAndre Fischer 1199f91b7e3SAndre Fischer 1209f91b7e3SAndre Fischer 1219f91b7e3SAndre Fischer=head2 Commit($self) 1229f91b7e3SAndre Fischer 1239f91b7e3SAndre Fischer Write all modified tables back into the databse. 1249f91b7e3SAndre Fischer 1259f91b7e3SAndre Fischer=cut 126*60b96b8dSAndre Fischer 1279f91b7e3SAndre Fischersub Commit ($) 1289f91b7e3SAndre Fischer{ 1299f91b7e3SAndre Fischer my $self = shift; 1309f91b7e3SAndre Fischer 1319f91b7e3SAndre Fischer my @tables_to_update = (); 1329f91b7e3SAndre Fischer foreach my $table (values %{$self->{'tables'}}) 1339f91b7e3SAndre Fischer { 1349f91b7e3SAndre Fischer push @tables_to_update,$table if ($table->IsModified()); 1359f91b7e3SAndre Fischer } 1369f91b7e3SAndre Fischer 1379f91b7e3SAndre Fischer if (scalar @tables_to_update > 0) 1389f91b7e3SAndre Fischer { 1399f91b7e3SAndre Fischer $installer::logger::Info->printf("writing modified tables to database:\n"); 1409f91b7e3SAndre Fischer foreach my $table (@tables_to_update) 1419f91b7e3SAndre Fischer { 1429f91b7e3SAndre Fischer $installer::logger::Info->printf(" %s\n", $table->GetName()); 1439f91b7e3SAndre Fischer $self->PutTable($table); 1449f91b7e3SAndre Fischer } 1459f91b7e3SAndre Fischer 1469f91b7e3SAndre Fischer foreach my $table (@tables_to_update) 1479f91b7e3SAndre Fischer { 1489f91b7e3SAndre Fischer $table->UpdateTimestamp(); 1499f91b7e3SAndre Fischer $table->MarkAsUnmodified(); 1509f91b7e3SAndre Fischer } 1519f91b7e3SAndre Fischer } 1529f91b7e3SAndre Fischer} 1539f91b7e3SAndre Fischer 1549f91b7e3SAndre Fischer 1559f91b7e3SAndre Fischer 1569f91b7e3SAndre Fischer 1579f91b7e3SAndre Fischer=head2 GetTable($seld, $table_name) 1589f91b7e3SAndre Fischer 1599f91b7e3SAndre Fischer Return an MsiTable object for $table_name. Table objects are kept 1609f91b7e3SAndre Fischer alive for the life time of the Msi object. Therefore the second 1619f91b7e3SAndre Fischer call for the same table is very cheap. 1629f91b7e3SAndre Fischer 1639f91b7e3SAndre Fischer=cut 164*60b96b8dSAndre Fischer 1659f91b7e3SAndre Fischersub GetTable ($$) 1669f91b7e3SAndre Fischer{ 1679f91b7e3SAndre Fischer my ($self, $table_name) = @_; 1689f91b7e3SAndre Fischer 1699f91b7e3SAndre Fischer my $table = $self->{'tables'}->{$table_name}; 1709f91b7e3SAndre Fischer if ( ! defined $table) 1719f91b7e3SAndre Fischer { 1729f91b7e3SAndre Fischer my $table_filename = File::Spec->catfile($self->{'tmpdir'}, $table_name .".idt"); 1739f91b7e3SAndre Fischer if ( ! -f $table_filename 1749f91b7e3SAndre Fischer || ! EnsureAYoungerThanB($table_filename, $self->{'fullname'})) 1759f91b7e3SAndre Fischer { 1769f91b7e3SAndre Fischer # Extract table from database to text file on disk. 1779f91b7e3SAndre Fischer my $truncated_table_name = length($table_name)>8 ? substr($table_name,0,8) : $table_name; 1789f91b7e3SAndre Fischer my $command = join(" ", 1799f91b7e3SAndre Fischer "msidb.exe", 1809f91b7e3SAndre Fischer "-d", installer::patch::Tools::ToEscapedWindowsPath($self->{'filename'}), 1819f91b7e3SAndre Fischer "-f", installer::patch::Tools::ToEscapedWindowsPath($self->{'tmpdir'}), 1829f91b7e3SAndre Fischer "-e", $table_name); 1839f91b7e3SAndre Fischer my $result = qx($command); 1849f91b7e3SAndre Fischer print $result; 1859f91b7e3SAndre Fischer } 1869f91b7e3SAndre Fischer 1879f91b7e3SAndre Fischer # Read table into memory. 1889f91b7e3SAndre Fischer $table = new installer::patch::MsiTable($table_filename, $table_name); 1899f91b7e3SAndre Fischer $self->{'tables'}->{$table_name} = $table; 1909f91b7e3SAndre Fischer } 1919f91b7e3SAndre Fischer 1929f91b7e3SAndre Fischer return $table; 1939f91b7e3SAndre Fischer} 1949f91b7e3SAndre Fischer 1959f91b7e3SAndre Fischer 1969f91b7e3SAndre Fischer 1979f91b7e3SAndre Fischer 1989f91b7e3SAndre Fischer=head2 PutTable($self, $table) 1999f91b7e3SAndre Fischer 2009f91b7e3SAndre Fischer Write the given table back to the databse. 2019f91b7e3SAndre Fischer 2029f91b7e3SAndre Fischer=cut 203*60b96b8dSAndre Fischer 2049f91b7e3SAndre Fischersub PutTable ($$) 2059f91b7e3SAndre Fischer{ 2069f91b7e3SAndre Fischer my ($self, $table) = @_; 2079f91b7e3SAndre Fischer 2089f91b7e3SAndre Fischer # Create text file from the current table content. 2099f91b7e3SAndre Fischer $table->WriteFile(); 2109f91b7e3SAndre Fischer 2119f91b7e3SAndre Fischer my $table_name = $table->GetName(); 2129f91b7e3SAndre Fischer 2139f91b7e3SAndre Fischer # Store table from text file into database. 2149f91b7e3SAndre Fischer my $table_filename = $table->{'filename'}; 2159f91b7e3SAndre Fischer 2169f91b7e3SAndre Fischer if (length($table_name) > 8) 2179f91b7e3SAndre Fischer { 2189f91b7e3SAndre Fischer # The file name of the table data must not be longer than 8 characters (not counting the extension). 2199f91b7e3SAndre Fischer # The name passed as argument to the -i option may be longer. 2209f91b7e3SAndre Fischer my $truncated_table_name = substr($table_name,0,8); 2219f91b7e3SAndre Fischer my $table_truncated_filename = File::Spec->catfile( 2229f91b7e3SAndre Fischer dirname($table_filename), 2239f91b7e3SAndre Fischer $truncated_table_name.".idt"); 2249f91b7e3SAndre Fischer File::Copy::copy($table_filename, $table_truncated_filename) || die("can not create table file with short name"); 2259f91b7e3SAndre Fischer } 2269f91b7e3SAndre Fischer 2279f91b7e3SAndre Fischer my $command = join(" ", 2289f91b7e3SAndre Fischer "msidb.exe", 2299f91b7e3SAndre Fischer "-d", installer::patch::Tools::ToEscapedWindowsPath($self->{'filename'}), 2309f91b7e3SAndre Fischer "-f", installer::patch::Tools::ToEscapedWindowsPath($self->{'tmpdir'}), 2319f91b7e3SAndre Fischer "-i", $table_name); 2329f91b7e3SAndre Fischer my $result = system($command); 2339f91b7e3SAndre Fischer 2349f91b7e3SAndre Fischer if ($result != 0) 2359f91b7e3SAndre Fischer { 2369f91b7e3SAndre Fischer installer::logger::PrintError("writing table '%s' back to database failed", $table_name); 2379f91b7e3SAndre Fischer # For error messages see http://msdn.microsoft.com/en-us/library/windows/desktop/aa372835%28v=vs.85%29.aspx 2389f91b7e3SAndre Fischer } 2399f91b7e3SAndre Fischer} 2409f91b7e3SAndre Fischer 2419f91b7e3SAndre Fischer 2429f91b7e3SAndre Fischer 2439f91b7e3SAndre Fischer 2449f91b7e3SAndre Fischer=head2 EnsureAYoungerThanB ($filename_a, $filename_b) 2459f91b7e3SAndre Fischer 2469f91b7e3SAndre Fischer Internal function (not a method) that compares to files according 2479f91b7e3SAndre Fischer to their last modification times (mtime). 2489f91b7e3SAndre Fischer 2499f91b7e3SAndre Fischer=cut 250*60b96b8dSAndre Fischer 2519f91b7e3SAndre Fischersub EnsureAYoungerThanB ($$) 2529f91b7e3SAndre Fischer{ 2539f91b7e3SAndre Fischer my ($filename_a, $filename_b) = @_; 2549f91b7e3SAndre Fischer 2559f91b7e3SAndre Fischer die("file $filename_a does not exist") unless -f $filename_a; 2569f91b7e3SAndre Fischer die("file $filename_b does not exist") unless -f $filename_b; 2579f91b7e3SAndre Fischer 2589f91b7e3SAndre Fischer my @stat_a = stat($filename_a); 2599f91b7e3SAndre Fischer my @stat_b = stat($filename_b); 2609f91b7e3SAndre Fischer 2619f91b7e3SAndre Fischer if ($stat_a[9] <= $stat_b[9]) 2629f91b7e3SAndre Fischer { 2639f91b7e3SAndre Fischer return 0; 2649f91b7e3SAndre Fischer } 2659f91b7e3SAndre Fischer else 2669f91b7e3SAndre Fischer { 2679f91b7e3SAndre Fischer return 1; 2689f91b7e3SAndre Fischer } 2699f91b7e3SAndre Fischer} 2709f91b7e3SAndre Fischer 2719f91b7e3SAndre Fischer 2729f91b7e3SAndre Fischer 2739f91b7e3SAndre Fischer 2749f91b7e3SAndre Fischer=head2 SplitLongShortName($name) 2759f91b7e3SAndre Fischer 2769f91b7e3SAndre Fischer Split $name (typically from the 'FileName' column in the 'File' 2779f91b7e3SAndre Fischer table or 'DefaultDir' column in the 'Directory' table) at the '|' 2789f91b7e3SAndre Fischer into short (8.3) and long names. If there is no '|' in $name then 2799f91b7e3SAndre Fischer $name is returned as both short and long name. 2809f91b7e3SAndre Fischer 2819f91b7e3SAndre Fischer Returns long and short name (in this order) as array. 2829f91b7e3SAndre Fischer 2839f91b7e3SAndre Fischer=cut 284*60b96b8dSAndre Fischer 2859f91b7e3SAndre Fischersub SplitLongShortName ($) 2869f91b7e3SAndre Fischer{ 2879f91b7e3SAndre Fischer my ($name) = @_; 2889f91b7e3SAndre Fischer 2899f91b7e3SAndre Fischer if ($name =~ /^([^\|]*)\|(.*)$/) 2909f91b7e3SAndre Fischer { 2919f91b7e3SAndre Fischer return ($2,$1); 2929f91b7e3SAndre Fischer } 2939f91b7e3SAndre Fischer else 2949f91b7e3SAndre Fischer { 2959f91b7e3SAndre Fischer return ($name,$name); 2969f91b7e3SAndre Fischer } 2979f91b7e3SAndre Fischer} 2989f91b7e3SAndre Fischer 2999f91b7e3SAndre Fischer 3009f91b7e3SAndre Fischer 3019f91b7e3SAndre Fischer=head2 SplitTargetSourceLongShortName ($name) 3029f91b7e3SAndre Fischer 3039f91b7e3SAndre Fischer Split $name first at the ':' into target and source parts and each 3049f91b7e3SAndre Fischer of those at the '|'s into long and short parts. Names that follow 3059f91b7e3SAndre Fischer this pattern come from the 'DefaultDir' column in the 'Directory' 3069f91b7e3SAndre Fischer table. 3079f91b7e3SAndre Fischer 3089f91b7e3SAndre Fischer=cut 309*60b96b8dSAndre Fischer 3109f91b7e3SAndre Fischersub SplitTargetSourceLongShortName ($) 3119f91b7e3SAndre Fischer{ 3129f91b7e3SAndre Fischer my ($name) = @_; 3139f91b7e3SAndre Fischer 3149f91b7e3SAndre Fischer if ($name =~ /^([^:]*):(.*)$/) 3159f91b7e3SAndre Fischer { 3169f91b7e3SAndre Fischer return (installer::patch::Msi::SplitLongShortName($1), installer::patch::Msi::SplitLongShortName($2)); 3179f91b7e3SAndre Fischer } 3189f91b7e3SAndre Fischer else 3199f91b7e3SAndre Fischer { 3209f91b7e3SAndre Fischer my ($long,$short) = installer::patch::Msi::SplitLongShortName($name); 3219f91b7e3SAndre Fischer return ($long,$short,$long,$short); 3229f91b7e3SAndre Fischer } 3239f91b7e3SAndre Fischer} 3249f91b7e3SAndre Fischer 3259f91b7e3SAndre Fischer 3269f91b7e3SAndre Fischer=head2 GetDirectoryMap($self) 3279f91b7e3SAndre Fischer 3289f91b7e3SAndre Fischer Return a map that maps directory unique names (column 'Directory' in table 'Directory') 3299f91b7e3SAndre Fischer to hashes that contains short and long source and target names. 3309f91b7e3SAndre Fischer 3319f91b7e3SAndre Fischer=cut 332*60b96b8dSAndre Fischer 3339f91b7e3SAndre Fischersub GetDirectoryMap ($) 3349f91b7e3SAndre Fischer{ 3359f91b7e3SAndre Fischer my ($self) = @_; 3369f91b7e3SAndre Fischer 3379f91b7e3SAndre Fischer if (defined $self->{'DirectoryMap'}) 3389f91b7e3SAndre Fischer { 3399f91b7e3SAndre Fischer return $self->{'DirectoryMap'}; 3409f91b7e3SAndre Fischer } 3419f91b7e3SAndre Fischer 3429f91b7e3SAndre Fischer my $directory_table = $self->GetTable("Directory"); 3439f91b7e3SAndre Fischer my %dir_map = (); 3449f91b7e3SAndre Fischer foreach my $row (@{$directory_table->GetAllRows()}) 3459f91b7e3SAndre Fischer { 3469f91b7e3SAndre Fischer my ($target_long_name, $target_short_name, $source_long_name, $source_short_name) 3479f91b7e3SAndre Fischer = installer::patch::Msi::SplitTargetSourceLongShortName($row->GetValue("DefaultDir")); 3489f91b7e3SAndre Fischer my $unique_name = $row->GetValue("Directory"); 3499f91b7e3SAndre Fischer $dir_map{$unique_name} = 3509f91b7e3SAndre Fischer { 3519f91b7e3SAndre Fischer 'unique_name' => $unique_name, 3529f91b7e3SAndre Fischer 'parent' => $row->GetValue("Directory_Parent"), 3539f91b7e3SAndre Fischer 'default_dir' => $row->GetValue("DefaultDir"), 3549f91b7e3SAndre Fischer 'source_long_name' => $source_long_name, 3559f91b7e3SAndre Fischer 'source_short_name' => $source_short_name, 3569f91b7e3SAndre Fischer 'target_long_name' => $target_long_name, 3579f91b7e3SAndre Fischer 'target_short_name' => $target_short_name 3589f91b7e3SAndre Fischer }; 3599f91b7e3SAndre Fischer } 3609f91b7e3SAndre Fischer 3619f91b7e3SAndre Fischer # Set up full names for all directories. 3629f91b7e3SAndre Fischer my @todo = map {$_} (keys %dir_map); 3639f91b7e3SAndre Fischer while (scalar @todo > 0) 3649f91b7e3SAndre Fischer { 3659f91b7e3SAndre Fischer my $key = shift @todo; 3669f91b7e3SAndre Fischer my $item = $dir_map{$key}; 3679f91b7e3SAndre Fischer next if defined $item->{'full_source_name'}; 3689f91b7e3SAndre Fischer 3699f91b7e3SAndre Fischer if ($item->{'parent'} eq "") 3709f91b7e3SAndre Fischer { 3719f91b7e3SAndre Fischer # Directory has no parent => full names are the same as the name. 3729f91b7e3SAndre Fischer $item->{'full_source_long_name'} = $item->{'source_long_name'}; 3739f91b7e3SAndre Fischer $item->{'full_source_short_name'} = $item->{'source_short_name'}; 3749f91b7e3SAndre Fischer $item->{'full_target_long_name'} = $item->{'target_long_name'}; 3759f91b7e3SAndre Fischer $item->{'full_target_short_name'} = $item->{'target_short_name'}; 3769f91b7e3SAndre Fischer } 3779f91b7e3SAndre Fischer else 3789f91b7e3SAndre Fischer { 3799f91b7e3SAndre Fischer my $parent = $dir_map{$item->{'parent'}}; 3809f91b7e3SAndre Fischer if ( defined $parent->{'full_source_long_name'}) 3819f91b7e3SAndre Fischer { 3829f91b7e3SAndre Fischer # Parent aleady has full names => we can create the full name of the current item. 3839f91b7e3SAndre Fischer $item->{'full_source_long_name'} 3849f91b7e3SAndre Fischer = $parent->{'full_source_long_name'} . "/" . $item->{'source_long_name'}; 3859f91b7e3SAndre Fischer $item->{'full_source_short_name'} 3869f91b7e3SAndre Fischer = $parent->{'full_source_short_name'} . "/" . $item->{'source_short_name'}; 3879f91b7e3SAndre Fischer $item->{'full_target_long_name'} 3889f91b7e3SAndre Fischer = $parent->{'full_target_long_name'} . "/" . $item->{'target_long_name'}; 3899f91b7e3SAndre Fischer $item->{'full_target_short_name'} 3909f91b7e3SAndre Fischer = $parent->{'full_target_short_name'} . "/" . $item->{'target_short_name'}; 3919f91b7e3SAndre Fischer } 3929f91b7e3SAndre Fischer else 3939f91b7e3SAndre Fischer { 3949f91b7e3SAndre Fischer # Parent has to be processed before the current item can be processed. 3959f91b7e3SAndre Fischer # Push both to the head of the list. 3969f91b7e3SAndre Fischer unshift @todo, $key; 3979f91b7e3SAndre Fischer unshift @todo, $item->{'parent'}; 3989f91b7e3SAndre Fischer } 3999f91b7e3SAndre Fischer } 4009f91b7e3SAndre Fischer } 4019f91b7e3SAndre Fischer 4029f91b7e3SAndre Fischer # Postprocess the path names for cleanup. 4039f91b7e3SAndre Fischer foreach my $item (values %dir_map) 4049f91b7e3SAndre Fischer { 4059f91b7e3SAndre Fischer foreach my $id ( 4069f91b7e3SAndre Fischer 'full_source_long_name', 4079f91b7e3SAndre Fischer 'full_source_short_name', 4089f91b7e3SAndre Fischer 'full_target_long_name', 4099f91b7e3SAndre Fischer 'full_target_short_name') 4109f91b7e3SAndre Fischer { 4119f91b7e3SAndre Fischer $item->{$id} =~ s/\/(\.\/)+/\//g; 4129f91b7e3SAndre Fischer $item->{$id} =~ s/^SourceDir\///; 4139f91b7e3SAndre Fischer $item->{$id} =~ s/^\.$//; 4149f91b7e3SAndre Fischer } 4159f91b7e3SAndre Fischer } 4169f91b7e3SAndre Fischer 4179f91b7e3SAndre Fischer $self->{'DirectoryMap'} = \%dir_map; 4189f91b7e3SAndre Fischer return $self->{'DirectoryMap'}; 4199f91b7e3SAndre Fischer} 4209f91b7e3SAndre Fischer 4219f91b7e3SAndre Fischer 4229f91b7e3SAndre Fischer 4239f91b7e3SAndre Fischer 4249f91b7e3SAndre Fischer=head2 GetFileMap ($) 4259f91b7e3SAndre Fischer 4269f91b7e3SAndre Fischer Return a map (hash) that maps the unique name (column 'File' in 4279f91b7e3SAndre Fischer the 'File' table) to data that is associated with that file, like 4289f91b7e3SAndre Fischer the directory or component. 4299f91b7e3SAndre Fischer 4309f91b7e3SAndre Fischer The map is kept alive for the lifetime of the Msi object. All 4319f91b7e3SAndre Fischer calls but the first are cheap. 4329f91b7e3SAndre Fischer 4339f91b7e3SAndre Fischer=cut 434*60b96b8dSAndre Fischer 4359f91b7e3SAndre Fischersub GetFileMap ($) 4369f91b7e3SAndre Fischer{ 4379f91b7e3SAndre Fischer my ($self) = @_; 4389f91b7e3SAndre Fischer 4399f91b7e3SAndre Fischer if (defined $self->{'FileMap'}) 4409f91b7e3SAndre Fischer { 4419f91b7e3SAndre Fischer return $self->{'FileMap'}; 4429f91b7e3SAndre Fischer } 4439f91b7e3SAndre Fischer 4449f91b7e3SAndre Fischer my $file_table = $self->GetTable("File"); 4459f91b7e3SAndre Fischer my $component_table = $self->GetTable("Component"); 4469f91b7e3SAndre Fischer my $dir_map = $self->GetDirectoryMap(); 4479f91b7e3SAndre Fischer 4489f91b7e3SAndre Fischer # Setup a map from component names to directory items. 4499f91b7e3SAndre Fischer my %component_to_directory_map = 4509f91b7e3SAndre Fischer map 4519f91b7e3SAndre Fischer {$_->GetValue('Component') => $_->GetValue('Directory_')} 4529f91b7e3SAndre Fischer @{$component_table->GetAllRows()}; 4539f91b7e3SAndre Fischer 4549f91b7e3SAndre Fischer # Finally, create the map from files to directories. 4559f91b7e3SAndre Fischer my $file_map = {}; 4569f91b7e3SAndre Fischer my $file_component_index = $file_table->GetColumnIndex("Component_"); 4579f91b7e3SAndre Fischer my $file_file_index = $file_table->GetColumnIndex("File"); 4589f91b7e3SAndre Fischer foreach my $file_row (@{$file_table->GetAllRows()}) 4599f91b7e3SAndre Fischer { 4609f91b7e3SAndre Fischer my $component_name = $file_row->GetValue($file_component_index); 4619f91b7e3SAndre Fischer my $directory_name = $component_to_directory_map{$component_name}; 4629f91b7e3SAndre Fischer my $unique_name = $file_row->GetValue($file_file_index); 4639f91b7e3SAndre Fischer $file_map->{$unique_name} = { 4649f91b7e3SAndre Fischer 'directory' => $dir_map->{$directory_name}, 4659f91b7e3SAndre Fischer 'component_name' => $component_name 4669f91b7e3SAndre Fischer }; 4679f91b7e3SAndre Fischer } 4689f91b7e3SAndre Fischer 4699f91b7e3SAndre Fischer $self->{'FileMap'} = $file_map; 4709f91b7e3SAndre Fischer return $file_map; 4719f91b7e3SAndre Fischer} 4729f91b7e3SAndre Fischer 4739f91b7e3SAndre Fischer 4749f91b7e3SAndre Fischer1; 475