You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@openoffice.apache.org by af...@apache.org on 2013/12/04 09:51:31 UTC
svn commit: r1547732 [2/4] - in /openoffice/trunk/main:
instsetoo_native/data/ instsetoo_native/util/ solenv/bin/
solenv/bin/modules/installer/ solenv/bin/modules/installer/patch/
solenv/bin/modules/installer/windows/
Modified: openoffice/trunk/main/solenv/bin/modules/installer/patch/Msi.pm
URL: http://svn.apache.org/viewvc/openoffice/trunk/main/solenv/bin/modules/installer/patch/Msi.pm?rev=1547732&r1=1547731&r2=1547732&view=diff
==============================================================================
--- openoffice/trunk/main/solenv/bin/modules/installer/patch/Msi.pm (original)
+++ openoffice/trunk/main/solenv/bin/modules/installer/patch/Msi.pm Wed Dec 4 08:51:30 2013
@@ -1,342 +1,465 @@
-#**************************************************************
-#
-# Licensed to the Apache Software Foundation (ASF) under one
-# or more contributor license agreements. See the NOTICE file
-# distributed with this work for additional information
-# regarding copyright ownership. The ASF licenses this file
-# to you under the Apache License, Version 2.0 (the
-# "License"); you may not use this file except in compliance
-# with the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing,
-# software distributed under the License is distributed on an
-# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
-# KIND, either express or implied. See the License for the
-# specific language governing permissions and limitations
-# under the License.
-#
-#**************************************************************
-
-package installer::patch::Msi;
-
-use installer::patch::MsiTable;
-use installer::patch::Tools;
-use strict;
-
-
-=head1 NAME
-
- package installer::patch::Msi - Class represents a single MSI file and gives access to its tables.
-
-=cut
-
-
-
-=head2 new($class, $version, $language, $product_name)
-
- Create a new object of the Msi class. The values of $version, $language, and $product_name define
- where to look for the msi file.
-
- If construction fails then IsValid() will return false.
-
-=cut
-sub new ($$$$)
-{
- my ($class, $version, $language, $product_name) = @_;
-
- my $path = installer::patch::InstallationSet::GetUnpackedMsiPath(
- $version,
- $language,
- "msi",
- $product_name);
-
- # Find the msi in the path.
- my $filename = undef;
- if ( -d $path)
- {
- my @msi_files = glob(File::Spec->catfile($path, "*.msi"));
- if (scalar @msi_files != 1)
- {
- printf STDERR ("there are %d msi files in %s, should be 1", scalar @msi_files, $filename);
- $filename = "";
- }
- else
- {
- $filename = $msi_files[0];
- }
- }
- else
- {
- installer::logger::PrintError("can not access path '%s' to find msi\n", $path);
- return undef;
- }
-
- if ( ! -f $filename)
- {
- installer::logger::PrintError("can not access MSI file at '%s'\n", $filename);
- return undef;
- }
-
- my $self = {
- 'filename' => $filename,
- 'path' => $path,
- 'version' => $version,
- 'language' => $language,
- 'package_format' => "msi",
- 'product_name' => $product_name,
- 'tmpdir' => File::Temp->newdir(CLEANUP => 1),
- 'is_valid' => -f $filename
- };
- bless($self, $class);
-
- return $self;
-}
-
-
-
-
-sub IsValid ($)
-{
- my ($self) = @_;
-
- return $self->{'is_valid'};
-}
-
-
-
-
-=head2 GetTable($seld, $table_name)
-
- Return an MsiTable object for $table_name. Table objects are kept
- alive for the life time of the Msi object. Therefore the second
- call for the same table is very cheap.
-
-=cut
-sub GetTable ($$)
-{
- my ($self, $table_name) = @_;
-
- my $table = $self->{'tables'}->{$table_name};
- if ( ! defined $table)
- {
- my $table_filename = File::Spec->catfile($self->{'tmpdir'}, $table_name .".idt");
- if ( ! -f $table_filename
- || ! EnsureAYoungerThanB($table_filename, $self->{'fullname'}))
- {
- # Extract table from database to text file on disk.
- my $truncated_table_name = length($table_name)>8 ? substr($table_name,0,8) : $table_name;
- my $command = join(" ",
- "msidb.exe",
- "-d", installer::patch::Tools::CygpathToWindows($self->{'filename'}),
- "-f", installer::patch::Tools::CygpathToWindows($self->{'tmpdir'}),
- "-e", $table_name);
- my $result = qx($command);
- print $result;
- }
-
- # Read table into memory.
- $table = new installer::patch::MsiTable($table_filename, $table_name);
- $self->{'tables'}->{$table_name} = $table;
- }
-
- return $table;
-}
-
-
-
-
-=head2 EnsureAYoungerThanB ($filename_a, $filename_b)
-
- Internal function (not a method) that compares to files according
- to their last modification times (mtime).
-
-=cut
-sub EnsureAYoungerThanB ($$)
-{
- my ($filename_a, $filename_b) = @_;
-
- die("file $filename_a does not exist") unless -f $filename_a;
- die("file $filename_b does not exist") unless -f $filename_b;
-
- my @stat_a = stat($filename_a);
- my @stat_b = stat($filename_b);
-
- if ($stat_a[9] <= $stat_b[9])
- {
- return 0;
- }
- else
- {
- return 1;
- }
-}
-
-
-
-
-=head2 SplitLongShortName($name)
-
- Split $name (typically from the 'FileName' column in the 'File'
- table or 'DefaultDir' column in the 'Directory' table) at the '|'
- into short (8.3) and long names. If there is no '|' in $name then
- $name is returned as both short and long name.
-
- Returns long and short name (in this order) as array.
-
-=cut
-sub SplitLongShortName ($)
-{
- my ($name) = @_;
-
- if ($name =~ /^([^\|]*)\|(.*)$/)
- {
- return ($2,$1);
- }
- else
- {
- return ($name,$name);
- }
-}
-
-
-
-=head2 SplitTargetSourceLongShortName ($name)
-
- Split $name first at the ':' into target and source parts and each
- of those at the '|'s into long and short parts. Names that follow
- this pattern come from the 'DefaultDir' column in the 'Directory'
- table.
-
-=cut
-sub SplitTargetSourceLongShortName ($)
-{
- my ($name) = @_;
-
- if ($name =~ /^([^:]*):(.*)$/)
- {
- return (installer::patch::Msi::SplitLongShortName($1), installer::patch::Msi::SplitLongShortName($2));
- }
- else
- {
- my ($long,$short) = installer::patch::Msi::SplitLongShortName($name);
- return ($long,$short,$long,$short);
- }
-}
-
-
-
-
-=head2 GetFileToDirectoryMap ($)
-
- Return a map (hash) that maps the unique name (column 'File' in
- the 'File' table) to its directory names. Each value is a
- reference to an array of two elements: the source path and the
- target path.
-
- The map is kept alive for the lifetime of the Msi object. All
- calls but the first are cheap.
-
-=cut
-sub GetFileToDirectoryMap ($)
-{
- my ($self) = @_;
-
- if (defined $self->{'FileToDirectoryMap'})
- {
- return $self->{'FileToDirectoryMap'};
- }
-
- my $file_table = $self->GetTable("File");
- my $directory_table = $self->GetTable("Directory");
- my $component_table = $self->GetTable("Component");
- $installer::logger::Info->printf("got access to tables File, Directory, Component\n");
-
- my %dir_map = ();
- foreach my $row (@{$directory_table->GetAllRows()})
- {
- my ($target_name, undef, $source_name, undef)
- = installer::patch::Msi::SplitTargetSourceLongShortName($row->GetValue("DefaultDir"));
- $dir_map{$row->GetValue("Directory")} = {
- 'parent' => $row->GetValue("Directory_Parent"),
- 'source_name' => $source_name,
- 'target_name' => $target_name};
- }
-
- # Set up full names for all directories.
- my @todo = map {$_} (keys %dir_map);
- my $process_count = 0;
- my $push_count = 0;
- while (scalar @todo > 0)
- {
- ++$process_count;
-
- my $key = shift @todo;
- my $item = $dir_map{$key};
- next if defined $item->{'full_source_name'};
-
- if ($item->{'parent'} eq "")
- {
- # Directory has no parent => full names are the same as the name.
- $item->{'full_source_name'} = $item->{'source_name'};
- $item->{'full_target_name'} = $item->{'target_name'};
- }
- else
- {
- my $parent = $dir_map{$item->{'parent'}};
- if ( defined $parent->{'full_source_name'})
- {
- # Parent aleady has full names => we can create the full name of the current item.
- $item->{'full_source_name'} = $parent->{'full_source_name'} . "/" . $item->{'source_name'};
- $item->{'full_target_name'} = $parent->{'full_target_name'} . "/" . $item->{'target_name'};
- }
- else
- {
- # Parent has to be processed before the current item can be processed.
- # Push both to the head of the list.
- unshift @todo, $key;
- unshift @todo, $item->{'parent'};
-
- ++$push_count;
- }
- }
- }
-
- foreach my $key (keys %dir_map)
- {
- $dir_map{$key}->{'full_source_name'} =~ s/\/(\.\/)+/\//g;
- $dir_map{$key}->{'full_source_name'} =~ s/^SourceDir\///;
- $dir_map{$key}->{'full_target_name'} =~ s/\/(\.\/)+/\//g;
- $dir_map{$key}->{'full_target_name'} =~ s/^SourceDir\///;
- }
- $installer::logger::Info->printf("for %d directories there where %d processing steps and %d pushes\n",
- $directory_table->GetRowCount(),
- $process_count,
- $push_count);
-
- # Setup a map from component names to directory items.
- my %component_to_directory_map = map {$_->GetValue('Component') => $_->GetValue('Directory_')} @{$component_table->GetAllRows()};
-
- # Finally, create the map from files to directories.
- my $map = {};
- my $file_component_index = $file_table->GetColumnIndex("Component_");
- my $file_file_index = $file_table->GetColumnIndex("File");
- foreach my $file_row (@{$file_table->GetAllRows()})
- {
- my $component_name = $file_row->GetValue($file_component_index);
- my $directory_name = $component_to_directory_map{$component_name};
- my $dir_item = $dir_map{$directory_name};
- my $unique_name = $file_row->GetValue($file_file_index);
- $map->{$unique_name} = [$dir_item->{'full_source_name'},$dir_item->{'full_target_name'}];
- }
-
- $installer::logger::Info->printf("got full paths for %d files\n",
- $file_table->GetRowCount());
-
- $self->{'FileToDirectoryMap'} = $map;
- return $map;
-}
-
-
-1;
+#**************************************************************
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+#**************************************************************
+
+package installer::patch::Msi;
+
+use installer::patch::MsiTable;
+use installer::patch::Tools;
+use installer::patch::InstallationSet;
+
+use File::Basename;
+use File::Copy;
+
+use strict;
+
+
+=head1 NAME
+
+ package installer::patch::Msi - Class represents a single MSI file and gives access to its tables.
+
+=cut
+
+sub FindAndCreate($$$$$)
+{
+ my ($class, $version, $is_current_version, $language, $product_name) = @_;
+
+ my $condensed_version = $version;
+ $condensed_version =~ s/\.//g;
+
+ # When $version is the current version we have to search the msi at a different place.
+ my $path;
+ my $filename;
+ my $is_current = 0;
+ $path = installer::patch::InstallationSet::GetUnpackedExePath(
+ $version,
+ $is_current_version,
+ $language,
+ "msi",
+ $product_name);
+
+ # Find the msi in the path.ls .
+ $filename = File::Spec->catfile($path, "openoffice".$condensed_version.".msi");
+ $is_current = $is_current_version;
+
+ return $class->new($filename, $version, $is_current, $language, $product_name);
+}
+
+
+
+
+
+
+=head2 new($class, $filename, $version, $is_current_version, $language, $product_name)
+
+ Create a new object of the Msi class. The values of $version, $language, and $product_name define
+ where to look for the msi file.
+
+ If construction fails then IsValid() will return false.
+
+=cut
+sub new ($$$$$$)
+{
+ my ($class, $filename, $version, $is_current_version, $language, $product_name) = @_;
+
+ if ( ! -f $filename)
+ {
+ installer::logger::PrintError("can not find the .msi file for version %s and language %s at '%s'\n",
+ $version,
+ $language,
+ $filename);
+ return undef;
+ }
+
+ my $self = {
+ 'filename' => $filename,
+ 'path' => dirname($filename),
+ 'version' => $version,
+ 'is_current_version' => $is_current_version,
+ 'language' => $language,
+ 'package_format' => "msi",
+ 'product_name' => $product_name,
+ 'tmpdir' => File::Temp->newdir(CLEANUP => 1),
+ 'is_valid' => -f $filename
+ };
+ bless($self, $class);
+
+ return $self;
+}
+
+
+
+
+sub IsValid ($)
+{
+ my ($self) = @_;
+
+ return $self->{'is_valid'};
+}
+
+
+
+
+=head2 Commit($self)
+
+ Write all modified tables back into the databse.
+
+=cut
+sub Commit ($)
+{
+ my $self = shift;
+
+ my @tables_to_update = ();
+ foreach my $table (values %{$self->{'tables'}})
+ {
+ push @tables_to_update,$table if ($table->IsModified());
+ }
+
+ if (scalar @tables_to_update > 0)
+ {
+ $installer::logger::Info->printf("writing modified tables to database:\n");
+ foreach my $table (@tables_to_update)
+ {
+ $installer::logger::Info->printf(" %s\n", $table->GetName());
+ $self->PutTable($table);
+ }
+
+ foreach my $table (@tables_to_update)
+ {
+ $table->UpdateTimestamp();
+ $table->MarkAsUnmodified();
+ }
+ }
+}
+
+
+
+
+=head2 GetTable($seld, $table_name)
+
+ Return an MsiTable object for $table_name. Table objects are kept
+ alive for the life time of the Msi object. Therefore the second
+ call for the same table is very cheap.
+
+=cut
+sub GetTable ($$)
+{
+ my ($self, $table_name) = @_;
+
+ my $table = $self->{'tables'}->{$table_name};
+ if ( ! defined $table)
+ {
+ my $table_filename = File::Spec->catfile($self->{'tmpdir'}, $table_name .".idt");
+ if ( ! -f $table_filename
+ || ! EnsureAYoungerThanB($table_filename, $self->{'fullname'}))
+ {
+ # Extract table from database to text file on disk.
+ my $truncated_table_name = length($table_name)>8 ? substr($table_name,0,8) : $table_name;
+ my $command = join(" ",
+ "msidb.exe",
+ "-d", installer::patch::Tools::ToEscapedWindowsPath($self->{'filename'}),
+ "-f", installer::patch::Tools::ToEscapedWindowsPath($self->{'tmpdir'}),
+ "-e", $table_name);
+ my $result = qx($command);
+ print $result;
+ }
+
+ # Read table into memory.
+ $table = new installer::patch::MsiTable($table_filename, $table_name);
+ $self->{'tables'}->{$table_name} = $table;
+ }
+
+ return $table;
+}
+
+
+
+
+=head2 PutTable($self, $table)
+
+ Write the given table back to the databse.
+
+=cut
+sub PutTable ($$)
+{
+ my ($self, $table) = @_;
+
+ # Create text file from the current table content.
+ $table->WriteFile();
+
+ my $table_name = $table->GetName();
+
+ # Store table from text file into database.
+ my $table_filename = $table->{'filename'};
+
+ if (length($table_name) > 8)
+ {
+ # The file name of the table data must not be longer than 8 characters (not counting the extension).
+ # The name passed as argument to the -i option may be longer.
+ my $truncated_table_name = substr($table_name,0,8);
+ my $table_truncated_filename = File::Spec->catfile(
+ dirname($table_filename),
+ $truncated_table_name.".idt");
+ File::Copy::copy($table_filename, $table_truncated_filename) || die("can not create table file with short name");
+ }
+
+ my $command = join(" ",
+ "msidb.exe",
+ "-d", installer::patch::Tools::ToEscapedWindowsPath($self->{'filename'}),
+ "-f", installer::patch::Tools::ToEscapedWindowsPath($self->{'tmpdir'}),
+ "-i", $table_name);
+ my $result = system($command);
+
+ if ($result != 0)
+ {
+ installer::logger::PrintError("writing table '%s' back to database failed", $table_name);
+ # For error messages see http://msdn.microsoft.com/en-us/library/windows/desktop/aa372835%28v=vs.85%29.aspx
+ }
+}
+
+
+
+
+=head2 EnsureAYoungerThanB ($filename_a, $filename_b)
+
+ Internal function (not a method) that compares to files according
+ to their last modification times (mtime).
+
+=cut
+sub EnsureAYoungerThanB ($$)
+{
+ my ($filename_a, $filename_b) = @_;
+
+ die("file $filename_a does not exist") unless -f $filename_a;
+ die("file $filename_b does not exist") unless -f $filename_b;
+
+ my @stat_a = stat($filename_a);
+ my @stat_b = stat($filename_b);
+
+ if ($stat_a[9] <= $stat_b[9])
+ {
+ return 0;
+ }
+ else
+ {
+ return 1;
+ }
+}
+
+
+
+
+=head2 SplitLongShortName($name)
+
+ Split $name (typically from the 'FileName' column in the 'File'
+ table or 'DefaultDir' column in the 'Directory' table) at the '|'
+ into short (8.3) and long names. If there is no '|' in $name then
+ $name is returned as both short and long name.
+
+ Returns long and short name (in this order) as array.
+
+=cut
+sub SplitLongShortName ($)
+{
+ my ($name) = @_;
+
+ if ($name =~ /^([^\|]*)\|(.*)$/)
+ {
+ return ($2,$1);
+ }
+ else
+ {
+ return ($name,$name);
+ }
+}
+
+
+
+=head2 SplitTargetSourceLongShortName ($name)
+
+ Split $name first at the ':' into target and source parts and each
+ of those at the '|'s into long and short parts. Names that follow
+ this pattern come from the 'DefaultDir' column in the 'Directory'
+ table.
+
+=cut
+sub SplitTargetSourceLongShortName ($)
+{
+ my ($name) = @_;
+
+ if ($name =~ /^([^:]*):(.*)$/)
+ {
+ return (installer::patch::Msi::SplitLongShortName($1), installer::patch::Msi::SplitLongShortName($2));
+ }
+ else
+ {
+ my ($long,$short) = installer::patch::Msi::SplitLongShortName($name);
+ return ($long,$short,$long,$short);
+ }
+}
+
+
+=head2 GetDirectoryMap($self)
+
+ Return a map that maps directory unique names (column 'Directory' in table 'Directory')
+ to hashes that contains short and long source and target names.
+
+=cut
+sub GetDirectoryMap ($)
+{
+ my ($self) = @_;
+
+ if (defined $self->{'DirectoryMap'})
+ {
+ return $self->{'DirectoryMap'};
+ }
+
+ my $directory_table = $self->GetTable("Directory");
+ my %dir_map = ();
+ foreach my $row (@{$directory_table->GetAllRows()})
+ {
+ my ($target_long_name, $target_short_name, $source_long_name, $source_short_name)
+ = installer::patch::Msi::SplitTargetSourceLongShortName($row->GetValue("DefaultDir"));
+ my $unique_name = $row->GetValue("Directory");
+ $dir_map{$unique_name} =
+ {
+ 'unique_name' => $unique_name,
+ 'parent' => $row->GetValue("Directory_Parent"),
+ 'default_dir' => $row->GetValue("DefaultDir"),
+ 'source_long_name' => $source_long_name,
+ 'source_short_name' => $source_short_name,
+ 'target_long_name' => $target_long_name,
+ 'target_short_name' => $target_short_name
+ };
+ }
+
+ # Set up full names for all directories.
+ my @todo = map {$_} (keys %dir_map);
+ while (scalar @todo > 0)
+ {
+ my $key = shift @todo;
+ my $item = $dir_map{$key};
+ next if defined $item->{'full_source_name'};
+
+ if ($item->{'parent'} eq "")
+ {
+ # Directory has no parent => full names are the same as the name.
+ $item->{'full_source_long_name'} = $item->{'source_long_name'};
+ $item->{'full_source_short_name'} = $item->{'source_short_name'};
+ $item->{'full_target_long_name'} = $item->{'target_long_name'};
+ $item->{'full_target_short_name'} = $item->{'target_short_name'};
+ }
+ else
+ {
+ my $parent = $dir_map{$item->{'parent'}};
+ if ( defined $parent->{'full_source_long_name'})
+ {
+ # Parent aleady has full names => we can create the full name of the current item.
+ $item->{'full_source_long_name'}
+ = $parent->{'full_source_long_name'} . "/" . $item->{'source_long_name'};
+ $item->{'full_source_short_name'}
+ = $parent->{'full_source_short_name'} . "/" . $item->{'source_short_name'};
+ $item->{'full_target_long_name'}
+ = $parent->{'full_target_long_name'} . "/" . $item->{'target_long_name'};
+ $item->{'full_target_short_name'}
+ = $parent->{'full_target_short_name'} . "/" . $item->{'target_short_name'};
+ }
+ else
+ {
+ # Parent has to be processed before the current item can be processed.
+ # Push both to the head of the list.
+ unshift @todo, $key;
+ unshift @todo, $item->{'parent'};
+ }
+ }
+ }
+
+ # Postprocess the path names for cleanup.
+ foreach my $item (values %dir_map)
+ {
+ foreach my $id (
+ 'full_source_long_name',
+ 'full_source_short_name',
+ 'full_target_long_name',
+ 'full_target_short_name')
+ {
+ $item->{$id} =~ s/\/(\.\/)+/\//g;
+ $item->{$id} =~ s/^SourceDir\///;
+ $item->{$id} =~ s/^\.$//;
+ }
+ }
+
+ $self->{'DirectoryMap'} = \%dir_map;
+ return $self->{'DirectoryMap'};
+}
+
+
+
+
+=head2 GetFileMap ($)
+
+ Return a map (hash) that maps the unique name (column 'File' in
+ the 'File' table) to data that is associated with that file, like
+ the directory or component.
+
+ The map is kept alive for the lifetime of the Msi object. All
+ calls but the first are cheap.
+
+=cut
+sub GetFileMap ($)
+{
+ my ($self) = @_;
+
+ if (defined $self->{'FileMap'})
+ {
+ return $self->{'FileMap'};
+ }
+
+ my $file_table = $self->GetTable("File");
+ my $component_table = $self->GetTable("Component");
+ my $dir_map = $self->GetDirectoryMap();
+
+ # Setup a map from component names to directory items.
+ my %component_to_directory_map =
+ map
+ {$_->GetValue('Component') => $_->GetValue('Directory_')}
+ @{$component_table->GetAllRows()};
+
+ # Finally, create the map from files to directories.
+ my $file_map = {};
+ my $file_component_index = $file_table->GetColumnIndex("Component_");
+ my $file_file_index = $file_table->GetColumnIndex("File");
+ foreach my $file_row (@{$file_table->GetAllRows()})
+ {
+ my $component_name = $file_row->GetValue($file_component_index);
+ my $directory_name = $component_to_directory_map{$component_name};
+ my $unique_name = $file_row->GetValue($file_file_index);
+ $file_map->{$unique_name} = {
+ 'directory' => $dir_map->{$directory_name},
+ 'component_name' => $component_name
+ };
+ }
+
+ $self->{'FileMap'} = $file_map;
+ return $file_map;
+}
+
+
+1;
Modified: openoffice/trunk/main/solenv/bin/modules/installer/patch/MsiRow.pm
URL: http://svn.apache.org/viewvc/openoffice/trunk/main/solenv/bin/modules/installer/patch/MsiRow.pm?rev=1547732&r1=1547731&r2=1547732&view=diff
==============================================================================
--- openoffice/trunk/main/solenv/bin/modules/installer/patch/MsiRow.pm (original)
+++ openoffice/trunk/main/solenv/bin/modules/installer/patch/MsiRow.pm Wed Dec 4 08:51:30 2013
@@ -1,160 +1,169 @@
-#**************************************************************
-#
-# Licensed to the Apache Software Foundation (ASF) under one
-# or more contributor license agreements. See the NOTICE file
-# distributed with this work for additional information
-# regarding copyright ownership. The ASF licenses this file
-# to you under the Apache License, Version 2.0 (the
-# "License"); you may not use this file except in compliance
-# with the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing,
-# software distributed under the License is distributed on an
-# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
-# KIND, either express or implied. See the License for the
-# specific language governing permissions and limitations
-# under the License.
-#
-#**************************************************************
-
-package installer::patch::MsiRow;
-
-=head1 NAME
-
- package installer::patch::MsiRow - Class that represents a single row of an Msi table.
-
-=cut
-
-
-=head2 new ($class, $table, @data)
-
- Create a new MsiRow object for the given table row data. Each row
- stores a reference to its $table so that it can access global
- values like column names.
-
-=cut
-sub new ($$@)
-{
- my ($class, $table, @data) = @_;
-
- my $self = {
- 'table' => $table,
- 'values' => [@data]
- };
- bless($self, $class);
-
- my $column_count = $table->GetColumnCount();
- while (scalar @{$self->{'values'}} < $column_count)
- {
- push @{$self->{'values'}}, "";
- }
-
- return $self;
-}
-
-
-
-=head2 GetValue($self, $column)
-
- Return the value in the column specified by $column, which can be
- either the column name or the index of the column.
-
-=cut
-sub GetValue ($$)
-{
- my ($self, $column) = @_;
-
- if ($column =~ /^\d+$/)
- {
- return $self->{'values'}->[$column];
- }
- else
- {
- my $column_index = $self->{'table'}->GetColumnIndex($column);
- return $self->{'values'}->[$column_index];
- }
-}
-
-
-
-
-sub SetValue ($$$)
-{
- my ($self, $column, $value) = @_;
-
- if ($column =~ /^\d+$/)
- {
- $self->{'values'}->[$column] = $value;
- }
- else
- {
- my $column_index = $self->{'table'}->GetColumnIndex($column);
- $self->{'values'}->[$column_index] = $value;
- }
- $self->{'table'}->MarkAsModified();
-}
-
-
-
-
-sub Format ($$)
-{
- my $self = shift;
- my $concatenation = shift;
-
- my $result = "";
- my $first = 1;
- my $index = 0;
- my $column_count = $self->{'table'}->GetColumnCount();
- foreach my $item (@{$self->{'values'}})
- {
- ++$index;
-
- if ( ! $first)
- {
- $result .= $concatenation;
- }
- else
- {
- $first = 0;
- }
- $result .= $item;
- }
- return $result;
-}
-
-
-
-
-sub Clone ($$)
-{
- my ($self, $new_table) = @_;
-
- my $clone = { %$self };
- $clone->{'values'} = [ @{$self->{'values'}} ];
- $clone->{'table'} = $new_table;
- bless($clone, "MsiRow");
-
- return $clone;
-}
-
-
-
-
-sub SetTable ($$)
-{
- my ($self, $new_table) = @_;
-
- if (defined $self->{'table'} && $self->{'table'} != $new_table)
- {
- MsiTools::Die("can not reset table of row");
- }
- else
- {
- $self->{'table'} = $new_table;
- }
-}
-
-1;
+#**************************************************************
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+#**************************************************************
+
+package installer::patch::MsiRow;
+
+=head1 NAME
+
+ package installer::patch::MsiRow - Class that represents a single row of an Msi table.
+
+=cut
+
+
+=head2 new ($class, $table, @data)
+
+ Create a new MsiRow object for the given table row data. Each row
+ stores a reference to its $table so that it can access global
+ values like column names.
+
+=cut
+sub new ($$@)
+{
+ my ($class, $table, @data) = @_;
+
+ my $self = {
+ 'table' => $table,
+ 'values' => [@data]
+ };
+ bless($self, $class);
+
+ my $column_count = $table->GetColumnCount();
+ while (scalar @{$self->{'values'}} < $column_count)
+ {
+ push @{$self->{'values'}}, "";
+ }
+
+ return $self;
+}
+
+
+
+=head2 GetValue($self, $column)
+
+ Return the value in the column specified by $column, which can be
+ either the column name or the index of the column.
+
+=cut
+sub GetValue ($$)
+{
+ my ($self, $column) = @_;
+
+ if ($column =~ /^\d+$/)
+ {
+ return $self->{'values'}->[$column];
+ }
+ else
+ {
+ my $column_index = $self->{'table'}->GetColumnIndex($column);
+ return $self->{'values'}->[$column_index];
+ }
+}
+
+
+
+
+sub SetValue ($$$)
+{
+ my ($self, $column, $value) = @_;
+
+ if ($column =~ /^\d+$/)
+ {
+ $self->{'values'}->[$column] = $value;
+ }
+ else
+ {
+ my $column_index = $self->{'table'}->GetColumnIndex($column);
+ $self->{'values'}->[$column_index] = $value;
+ }
+ $self->{'table'}->MarkAsModified();
+}
+
+
+
+
+sub GetAllValues ($)
+{
+ my ($self) = @_;
+ return @{$self->{'values'}};
+}
+
+
+
+
+sub Format ($$)
+{
+ my $self = shift;
+ my $concatenation = shift;
+
+ my $result = "";
+ my $first = 1;
+ my $index = 0;
+ my $column_count = $self->{'table'}->GetColumnCount();
+ foreach my $item (@{$self->{'values'}})
+ {
+ ++$index;
+
+ if ( ! $first)
+ {
+ $result .= $concatenation;
+ }
+ else
+ {
+ $first = 0;
+ }
+ $result .= $item;
+ }
+ return $result;
+}
+
+
+
+
+sub Clone ($$)
+{
+ my ($self, $new_table) = @_;
+
+ my $clone = { %$self };
+ $clone->{'values'} = [ @{$self->{'values'}} ];
+ $clone->{'table'} = $new_table;
+ bless($clone, "MsiRow");
+
+ return $clone;
+}
+
+
+
+
+sub SetTable ($$)
+{
+ my ($self, $new_table) = @_;
+
+ if (defined $self->{'table'} && $self->{'table'} != $new_table)
+ {
+ MsiTools::Die("can not reset table of row");
+ }
+ else
+ {
+ $self->{'table'} = $new_table;
+ }
+}
+
+1;
Modified: openoffice/trunk/main/solenv/bin/modules/installer/patch/MsiTable.pm
URL: http://svn.apache.org/viewvc/openoffice/trunk/main/solenv/bin/modules/installer/patch/MsiTable.pm?rev=1547732&r1=1547731&r2=1547732&view=diff
==============================================================================
--- openoffice/trunk/main/solenv/bin/modules/installer/patch/MsiTable.pm (original)
+++ openoffice/trunk/main/solenv/bin/modules/installer/patch/MsiTable.pm Wed Dec 4 08:51:30 2013
@@ -1,274 +1,492 @@
-#**************************************************************
-#
-# Licensed to the Apache Software Foundation (ASF) under one
-# or more contributor license agreements. See the NOTICE file
-# distributed with this work for additional information
-# regarding copyright ownership. The ASF licenses this file
-# to you under the Apache License, Version 2.0 (the
-# "License"); you may not use this file except in compliance
-# with the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing,
-# software distributed under the License is distributed on an
-# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
-# KIND, either express or implied. See the License for the
-# specific language governing permissions and limitations
-# under the License.
-#
-#**************************************************************
-
-package installer::patch::MsiTable;
-
-=head1 NAME
-
- package installer::patch::MsiTable - Class that represents one table of an Msi file.
-
-=cut
-
-use installer::patch::MsiRow;
-
-use strict;
-
-=head new ($class, $filename, $table_name)
-
- Create a new MsiTable object from the output of a previous
- msidb.exe run. The table is named $table_name, its data is read
- from $filename.
-
-=cut
-sub new ($$$)
-{
- my ($class, $filename, $table_name) = @_;
-
- my $self = {
- 'name' => $table_name,
- 'is_valid' => 1
- };
- bless($self, $class);
-
- if ( -f $filename)
- {
- $self->ReadFile($filename);
- }
- return $self;
-}
-
-
-
-
-sub IsValid ($)
-{
- my ($self) = @_;
- return $self->{'is_valid'};
-}
-
-
-
-
-sub Trim ($)
-{
- my $line = shift;
-
- $line =~ s/(^\s+|\s+$)//g;
-
- return $line;
-}
-
-
-
-=head2 ReadFile($self, $filename)
-
- Read the content of the table from the specified .idt file.
- For each row a MsiRow object is appended to $self->{'rows'}.
-
-=cut
-sub ReadFile ($$)
-{
- my ($self, $filename) = @_;
-
- if ( ! (-f $filename && -r $filename))
- {
- printf STDERR ("can not open idt file %s for reading\n", $filename);
- $self->{'is_valid'} = 0;
- return;
- }
-
- open my $in, "<", $filename;
-
- my $columns = Trim(<$in>);
- $self->{'columns'} = [split(/\t/, $columns)];
-
- my $column_specs = Trim(<$in>);
- $self->{'column_specs'} = [split(/\t/, $column_specs)];
-
- # Table name, index columns.
- my $line = Trim(<$in>);
- my @items = split(/\t/, $line);
- if (scalar @items == 3)
- {
- $self->{'codepage'} = shift @items;
- }
- my $table_name = shift @items;
- if ($table_name ne $self->{'name'})
- {
- printf STDERR ("reading wrong table data for table '%s' (got %s)\n", $self->{'name'}, $table_name);
- $self->{'is_valid'} = 0;
- return;
- }
- $self->{'index_columns'} = [@items];
- $self->{'index_column_index'} = $self->GetColumnIndex($items[0]);
-
- my $rows = [];
- while (<$in>)
- {
- # Remove all trailing returns and newlines. Keep trailing spaces and tabs.
- s/[\r\n]+$//g;
-
- my @items = split(/\t/, $_);
- push @$rows, new installer::patch::MsiRow($self, @items);
- }
- $self->{'rows'} = $rows;
-
- return $self;
-}
-
-
-
-=head2 GetColumnCount($self)
-
- Return the number of columns in the table.
-
-=cut
-sub GetColumnCount ($)
-{
- my ($self) = @_;
-
- return scalar @{$self->{'columns'}};
-}
-
-
-
-
-=head2 GetRowCount($self)
-
- Return the number of rows in the table.
-
-=cut
-sub GetRowCount ($)
-{
- my ($self) = @_;
-
- return scalar @{$self->{'rows'}};
-}
-
-
-
-
-=head2 GetColumnIndx($self, $column_name)
-
- Return the 0 based index of the column named $column_name. Use
- this to speed up (slightly) access to column values when accessing
- many or all rows of a table.
-
-=cut
-sub GetColumnIndex ($$)
-{
- my ($self, $column_name) = @_;
-
- my $index = 0;
- foreach my $name (@{$self->{'columns'}})
- {
- if ($name eq $column_name)
- {
- return $index;
- }
- ++$index;
- }
-
- printf STDERR ("did not find column %s in %s\n", $column_name, join(" and ", @{$self->{'columns'}}));
- return -1;
-}
-
-
-
-
-=head2 GetValue($self, $selector_column, $selector_column_value, $value_column)
-
- Find the row in which the $selector_column has value
- $selector_column_value and return its value in the $value_column.
-
-=cut
-
-sub GetValue ($$$$)
-{
- my ($self, $selector_column, $selector_column_value, $value_column) = @_;
-
- my $row = $self->GetRow($selector_column, $selector_column_value);
- if (defined $row)
- {
- return $row->GetValue($value_column);
- }
- else
- {
- return undef;
- }
-}
-
-
-
-
-=head2 GetRow($self, $column, $value)
-
- Return the (first) row which has $value in $column.
-
-=cut
-sub GetRow ($$$)
-{
- my ($self, $column, $value) = @_;
-
- my $column_index = $self->GetColumnIndex($column);
- if ($column_index<0)
- {
- printf STDERR "ERROR: unknown column $column in table $self->{'name'}\n";
- return undef;
- }
-
- foreach my $row (@{$self->{'rows'}})
- {
- if ($row->GetValue($column_index) eq $value)
- {
- return $row;
- }
- }
-
- printf STDERR ("ERROR: did not find row for %s->%s in %s\n",
- $column,
- $value,
- table $self->{'name'});
-
- return undef;
-}
-
-
-
-
-=head2 GetAllRows ($self)
-
- Return the reference to an array that contains all rows of the table.
-
-=cut
-
-sub GetAllRows ($)
-{
- my $self = shift;
-
- return $self->{'rows'};
-}
-
-
-
-
-
-1;
+#**************************************************************
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+#**************************************************************
+
+package installer::patch::MsiTable;
+
+=head1 NAME
+
+ package installer::patch::MsiTable - Class that represents one table of an Msi file.
+
+=cut
+
+use installer::patch::MsiRow;
+
+use strict;
+
+=head new ($class, $filename, $table_name)
+
+ Create a new MsiTable object from the output of a previous
+ msidb.exe run. The table is named $table_name, its data is read
+ from $filename.
+
+=cut
+sub new ($$$)
+{
+ my ($class, $filename, $table_name) = @_;
+
+ my $self = {
+ 'name' => $table_name,
+ 'filename' => $filename,
+ 'columns' => undef,
+ 'column_specs' => undef,
+ 'codepage' => undef,
+ 'is_valid' => 1,
+ 'is_modified' => 0
+ };
+ bless($self, $class);
+
+ if (defined $filename && -f $filename)
+ {
+ $self->ReadFile($filename);
+ }
+ return $self;
+}
+
+
+
+
+sub SetColumnData ($@)
+{
+ my ($self, @data) = @_;
+
+ if (((scalar @data) % 2) != 0)
+ {
+ installer::logger::PrintError("column data has to have an even number of elements: (<column-name> <data-spec>)+)\n");
+ $self->{'is_valid'} = 0;
+ return;
+ }
+
+ $self->{'columns'} = [];
+ $self->{'column_specs'} = [];
+ while (scalar @data > 0)
+ {
+ my $name = shift @data;
+ my $spec = shift @data;
+ push @{$self->{'columns'}}, $name;
+ push @{$self->{'column_specs'}}, $spec;
+ }
+}
+
+
+
+
+sub SetIndexColumns ($@)
+{
+ my ($self, @index_columns) = @_;
+
+ $self->{'index_columns'} = [@index_columns];
+}
+
+
+
+
+sub SetCodepage ($$)
+{
+ my ($self, $codepage) = @_;
+
+ $self->{'codepage'} = $codepage;
+}
+
+
+
+
+sub IsValid ($)
+{
+ my ($self) = @_;
+ return $self->{'is_valid'};
+}
+
+
+
+
+sub Trim ($)
+{
+ my $line = shift;
+
+ $line =~ s/(^\s+|\s+$)//g;
+
+ return $line;
+}
+
+
+
+=head2 ReadFile($self, $filename)
+
+ Read the content of the table from the specified .idt file.
+ For each row a MsiRow object is appended to $self->{'rows'}.
+
+=cut
+sub ReadFile ($$)
+{
+ my ($self, $filename) = @_;
+
+ if ( ! (-f $filename && -r $filename))
+ {
+ printf STDERR ("can not open idt file %s for reading\n", $filename);
+ $self->{'is_valid'} = 0;
+ return;
+ }
+
+ open my $in, "<", $filename;
+
+ my $columns = Trim(<$in>);
+ $self->{'columns'} = [split(/\t/, $columns)];
+
+ my $column_specs = Trim(<$in>);
+ $self->{'column_specs'} = [split(/\t/, $column_specs)];
+
+ # Table name, index columns.
+ my $line = Trim(<$in>);
+ my @items = split(/\t/, $line);
+ my $item_count = scalar @items;
+ if ($item_count>=1 && $items[0] eq $self->{'name'})
+ {
+ # No codepage.
+ }
+ elsif ($item_count>=2 && $items[1] eq $self->{'name'})
+ {
+ $self->{'codepage'} = shift @items;
+ }
+ else
+ {
+ printf STDERR ("reading wrong table data for table '%s' (got %s)\n", $self->{'name'}, $items[0]);
+ $self->{'is_valid'} = 0;
+ return;
+ }
+ shift @items;
+ $self->{'index_columns'} = [@items];
+ $self->{'index_column_index'} = $self->GetColumnIndex($items[0]);
+
+ my $rows = [];
+ while (<$in>)
+ {
+ # Remove all trailing returns and newlines. Keep trailing spaces and tabs.
+ s/[\r\n]+$//g;
+
+ my @items = split(/\t/, $_);
+ push @$rows, new installer::patch::MsiRow($self, @items);
+ }
+ $self->{'rows'} = $rows;
+
+ return $self;
+}
+
+
+
+
+=head WriteFile($self, $filename)
+
+ Write a text file containing the current table content.
+
+=cut
+sub WriteFile ($$)
+{
+ my ($self, $filename) = @_;
+
+ open my $out, ">".$self->{'filename'};
+
+ print $out join("\t", @{$self->{'columns'}})."\r\n";
+ print $out join("\t", @{$self->{'column_specs'}})."\r\n";
+ if (defined $self->{'codepage'})
+ {
+ print $out $self->{'codepage'} . "\t";
+ }
+ print $out $self->{'name'} . "\t";
+ print $out join("\t",@{$self->{'index_columns'}})."\r\n";
+
+ foreach my $row (@{$self->{'rows'}})
+ {
+ print $out $row->Format("\t")."\r\n";
+ }
+
+ close $out;
+}
+
+
+
+
+sub UpdateTimestamp ($)
+{
+ my $self = shift;
+
+ utime(undef,undef, $self->{'filename'});
+}
+
+
+
+
+sub GetName ($)
+{
+ my $self = shift;
+
+ return $self->{'name'};
+}
+
+
+
+
+=head2 GetColumnCount($self)
+
+ Return the number of columns in the table.
+
+=cut
+sub GetColumnCount ($)
+{
+ my ($self) = @_;
+
+ return scalar @{$self->{'columns'}};
+}
+
+
+
+
+=head2 GetRowCount($self)
+
+ Return the number of rows in the table.
+
+=cut
+sub GetRowCount ($)
+{
+ my ($self) = @_;
+
+ return scalar @{$self->{'rows'}};
+}
+
+
+
+
+=head2 GetColumnIndx($self, $column_name)
+
+ Return the 0 based index of the column named $column_name. Use
+ this to speed up (slightly) access to column values when accessing
+ many or all rows of a table.
+
+=cut
+sub GetColumnIndex ($$)
+{
+ my ($self, $column_name) = @_;
+
+ my $index = 0;
+ foreach my $name (@{$self->{'columns'}})
+ {
+ if ($name eq $column_name)
+ {
+ return $index;
+ }
+ ++$index;
+ }
+
+ printf STDERR ("did not find column %s in %s\n", $column_name, join(" and ", @{$self->{'columns'}}));
+ return -1;
+}
+
+
+
+=head2 GetRowIndex($self, $index_column_index, $index_column_value)
+
+ Return the index, starting at 0, of the (first) row that has value $index_column_value
+ in column with index $index_column_index.
+
+ Return -1 if now such row is found.
+
+=cut
+sub GetRowIndex ($$$)
+{
+ my ($self, $index_column_index, $index_column_value) = @_;
+
+ my $rows = $self->{'rows'};
+ for (my ($row_index,$row_count)=(0,scalar @$rows); $row_index<$row_count; ++$row_index)
+ {
+ my $row = $rows->[$row_index];
+ if ($row->GetValue($index_column_index) eq $index_column_value)
+ {
+ return $row_index;
+ }
+ }
+
+ return -1;
+}
+
+
+
+
+=head2 GetValue($self, $selector_column, $selector_column_value, $value_column)
+
+ Find the row in which the $selector_column has value
+ $selector_column_value and return its value in the $value_column.
+
+=cut
+
+sub GetValue ($$$$)
+{
+ my ($self, $selector_column, $selector_column_value, $value_column) = @_;
+
+ my $row = $self->GetRow($selector_column, $selector_column_value);
+ if (defined $row)
+ {
+ return $row->GetValue($value_column);
+ }
+ else
+ {
+ return undef;
+ }
+}
+
+
+
+
+=head2 GetRow($self, $column, $value)
+
+ Return the (first) row which has $value in $column.
+
+=cut
+sub GetRow ($$$)
+{
+ my ($self, $column, $value) = @_;
+
+ my $column_index = $self->GetColumnIndex($column);
+ if ($column_index<0)
+ {
+ printf STDERR "ERROR: unknown column $column in table $self->{'name'}\n";
+ return undef;
+ }
+
+ foreach my $row (@{$self->{'rows'}})
+ {
+ if ($row->GetValue($column_index) eq $value)
+ {
+ return $row;
+ }
+ }
+
+ printf STDERR ("ERROR: did not find row for %s->%s in %s\n",
+ $column,
+ $value,
+ table $self->{'name'});
+
+ return undef;
+}
+
+
+
+
+=head2 GetAllRows ($self)
+
+ Return the reference to an array that contains all rows of the table.
+
+=cut
+
+sub GetAllRows ($)
+{
+ my $self = shift;
+
+ return $self->{'rows'};
+}
+
+
+
+
+=head2 SetRow($self, {$key, $value}*)
+
+ Replace an existing row. If no matching row is found then add the row.
+
+ The row is defined by a set of key/value pairs. Their order is defined by the keys (column names)
+ and their indices as defined in $self->{'columns'}.
+
+ Rows are compared by their values of the index column. By default this is the first element of
+ $self->{'index_columns'} but is overruled by the last key that starts with a '*'.
+
+=cut
+sub SetRow ($@)
+{
+ my $self = shift;
+ my @data = @_;
+
+ my @items = ();
+ my $index_column = $self->{'index_columns'}->[0];
+
+ # Key/Value has to have an even number of entries.
+ MsiTools::Die("invalid arguments given to MsiTable::SetRow()\n") if (scalar @data%2) != 0;
+
+ # Find column indices for column names.
+ while (scalar @data > 0)
+ {
+ my $column_name = shift @data;
+ if ($column_name =~ /^\*(.*)$/)
+ {
+ # Column name starts with a '*'. Use it as index column.
+ $column_name = $1;
+ $index_column = $1;
+ }
+ my $value = shift @data;
+ my $column_index = $self->GetColumnIndex($column_name);
+ $items[$column_index] = $value;
+ }
+
+ my $index_column_index = $self->GetColumnIndex($index_column);
+ my $row_index = $self->GetRowIndex($index_column_index, $items[$index_column_index]);
+
+ if ($row_index < 0)
+ {
+ # Row does not yet exist. Add it.
+ push @{$self->{'rows'}}, installer::patch::MsiRow->new($self, @items);
+ }
+ else
+ {
+ # Row does already exist. Replace it.
+ $self->{'rows'}->[$row_index] = installer::patch::MsiRow->new($self, @items);
+ }
+
+ $self->MarkAsModified();
+}
+
+
+
+
+sub MarkAsModified ($)
+{
+ my $self = shift;
+
+ $self->{'is_modified'} = 1;
+}
+
+
+
+
+sub MarkAsUnmodified ($)
+{
+ my $self = shift;
+
+ $self->{'is_modified'} = 0;
+}
+
+
+
+
+sub IsModified ($)
+{
+ my $self = shift;
+
+ return $self->{'is_modified'};
+}
+
+
+1;
Modified: openoffice/trunk/main/solenv/bin/modules/installer/patch/ReleasesList.pm
URL: http://svn.apache.org/viewvc/openoffice/trunk/main/solenv/bin/modules/installer/patch/ReleasesList.pm?rev=1547732&r1=1547731&r2=1547732&view=diff
==============================================================================
--- openoffice/trunk/main/solenv/bin/modules/installer/patch/ReleasesList.pm (original)
+++ openoffice/trunk/main/solenv/bin/modules/installer/patch/ReleasesList.pm Wed Dec 4 08:51:30 2013
@@ -1,210 +1,375 @@
-#**************************************************************
-#
-# Licensed to the Apache Software Foundation (ASF) under one
-# or more contributor license agreements. See the NOTICE file
-# distributed with this work for additional information
-# regarding copyright ownership. The ASF licenses this file
-# to you under the Apache License, Version 2.0 (the
-# "License"); you may not use this file except in compliance
-# with the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing,
-# software distributed under the License is distributed on an
-# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
-# KIND, either express or implied. See the License for the
-# specific language governing permissions and limitations
-# under the License.
-#
-#**************************************************************
-
-package installer::patch::ReleasesList;
-
-use XML::LibXML;
-use File::Spec;
-use strict;
-
-=head1 NAME
-
- package installer::patch::ReleasesList - Functions for accessing the instsetoo_native/data/releases.xml file
-
-=cut
-
-
-my $Instance = undef;
-
-=head2 Instance()
-
- Return the singleton instance.
-
-=cut
-sub Instance()
-{
- if ( ! defined $Instance)
- {
- $Instance = new installer::patch::ReleasesList();
- }
- return $Instance;
-}
-
-
-
-
-=head2 new($class)
-
- Internal constructor. Don't call.
-
-=cut
-sub new ($)
-{
- my ($class) = @_;
-
- my $self = {};
- bless($self, $class);
-
- $self->Read();
-
- return $self;
-}
-
-
-
-
-=head2 GetFirstChild ($node, $child_name)
-
- Internal function that returns the first child. Use only when the
- first child is the (expected) only child in a list.
-
-=cut
-sub GetFirstChild ($$)
-{
- my ($node, $child_name) = @_;
-
- if ( ! defined $node)
- {
- return undef;
- }
- else
- {
- my @child_nodes = $node->getElementsByTagName($child_name);
- if (scalar @child_nodes == 0)
- {
- return undef;
- }
- else
- {
- return $child_nodes[0];
- }
- }
-}
-
-
-
-
-=head2 GetText ($node)
-
- Internal function that returns the trimmed text content of a node.
-
-=cut
-sub GetText ($)
-{
- my ($node) = @_;
-
- if ( ! defined $node)
- {
- return "";
- }
- else
- {
- my $text = $node->textContent();
- $text =~ s/(^\s+|\s+$)//g;
- return $text;
- }
-}
-
-
-
-
-=head2 Read($self)
-
- Read the releases.xml file as doctree and parse its content.
-
-=cut
-sub Read ($)
-{
- my ($self) = @_;
-
- my $filename = File::Spec->catfile($ENV{'SRC_ROOT'}, "instsetoo_native", "data", "releases.xml");
- my $parser = XML::LibXML->new();
- my $document = $parser->parse_file($filename);
- foreach my $release_node ($document->getElementsByTagName("release"))
- {
- my $version_node = GetFirstChild($release_node, "version");
- my $version = GetText($version_node);
- next if $version eq "";
-
- foreach my $download_node (GetFirstChild($release_node, "download"))
- {
- my $package_node = GetFirstChild($download_node, "package-format");
- my $package_format = GetText($package_node);
- next if $package_format eq "";
-
- my $download_data = ParseDownloadData($download_node);
- if (defined $download_data)
- {
- $self->{$version}->{$package_format} = $download_data;
- }
- }
- }
-
-}
-
-
-
-
-=head2 ParseDownloadData ($download_node)
-
- Parse the data for one set of download data (there is one per release and package format).
-
-=cut
-sub ParseDownloadData ($)
-{
- my ($download_node) = @_;
-
- my $url_node = GetFirstChild($download_node, "url-template");
- my $url_template = GetText($url_node);
- if ($url_template eq "")
- {
- print STDERR "releases data file corrupt (no URL template)\n";
- return undef;
- }
-
- my $download_data = {};
- foreach my $item_node (@{$download_node->getElementsByTagName("item")})
- {
- my $language = GetText(GetFirstChild($item_node, "language"));
- my $checksum_node = GetFirstChild($item_node, "checksum");
- if ( ! defined $checksum_node)
- {
- print STDERR "releases data file corrupt (item has no 'checksum' node)\n";
- return undef;
- }
- my $checksum_type = $checksum_node->getAttribute("type");
- my $checksum_value = GetText($checksum_node);
- my $file_size = GetText(GetFirstChild($item_node, "size"));
-
- my $url = $url_template;
- $url =~ s/\%L/$language/g;
- $download_data->{$language} = {
- 'URL' => $url,
- 'checksum-type' => $checksum_type,
- 'checksum-value' => $checksum_value,
- 'file-size' => $file_size
- };
- }
-
- return $download_data;
-}
-
-1;
+#**************************************************************
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+#**************************************************************
+
+package installer::patch::ReleasesList;
+
+use XML::Parser;
+use File::Spec;
+
+use strict;
+
+=head1 NAME
+
+ package installer::patch::ReleasesList - Functions for accessing the instsetoo_native/data/releases.xml file
+
+=cut
+
+
+my $Instance = undef;
+
+=head2 Instance()
+
+ Return the singleton instance.
+
+=cut
+sub Instance()
+{
+ if ( ! defined $Instance)
+ {
+ $Instance = new installer::patch::ReleasesList(
+ File::Spec->catfile($ENV{'SRC_ROOT'}, "instsetoo_native", "data", "releases.xml"));
+ }
+ return $Instance;
+}
+
+
+
+
+=head2 new($class, $filename)
+
+ Internal constructor. Don't call.
+
+=cut
+sub new ($$)
+{
+ my ($class, $filename) = @_;
+
+ my $self = {
+ 'releases' => []
+ };
+ bless($self, $class);
+
+
+ $self->Read($filename);
+
+
+ return $self;
+}
+
+
+
+
+=head2 GetFirstChild ($node, $child_name)
+
+ Internal function that returns the first child. Use only when the
+ first child is the (expected) only child in a list.
+
+=cut
+sub GetFirstChild ($$)
+{
+ my ($node, $child_name) = @_;
+
+ if ( ! defined $node)
+ {
+ return undef;
+ }
+ else
+ {
+ my $value = $node->{$child_name};
+ if (ref($value) eq 'ARRAY')
+ {
+ return $value->[0];
+ }
+ else
+ {
+ return $value;
+ }
+ }
+}
+
+
+
+
+=head2 GetText ($node)
+
+ Internal function that returns the trimmed text content of a node.
+
+=cut
+sub GetText ($;$)
+{
+ my ($node, $default_text) = @_;
+
+ if ( ! defined $node)
+ {
+ if (defined $default_text)
+ {
+ return $default_text;
+ }
+ else
+ {
+ return "";
+ }
+ }
+ else
+ {
+ my $text = $node->{'__text__'};
+ $text =~ s/(^\s+|\s+$)//g;
+ return $text;
+ }
+}
+
+
+
+sub GetAttribute ($$)
+{
+ my ($node, $attribute_name) = @_;
+
+ my $attributes = $node->{'__attributes__'};
+ if ( ! defined $attributes)
+ {
+ return undef;
+ }
+ else
+ {
+ return $attributes->{$attribute_name};
+ }
+}
+
+
+
+
+sub PrintNode($$);
+sub ReadDomTree ($)
+{
+ my ($filename) = @_;
+
+ my $root = {};
+ my $data = {
+ 'current_node' => $root,
+ 'node_stack' => []
+ };
+ my $parser = new XML::Parser(
+ 'Handlers' => {
+ 'Start' => sub {HandleStartTag($data, @_)},
+ 'End' => sub{HandleEndTag($data, @_)},
+ 'Char' => sub{HandleText($data, @_)}
+ });
+ $parser->parsefile($filename);
+
+# PrintNode("", $root);
+
+ return $root;
+}
+
+
+
+
+sub PrintNode($$)
+{
+ my ($indentation, $node) = @_;
+
+ if (defined $node->{'__attributes__'})
+ {
+ while (my ($name,$attribute) = each(%{$node->{'__attributes__'}}))
+ {
+ printf(" %s%s -> %s\n", $indentation, $name, $attribute);
+ }
+ }
+
+ while (my ($key,$value) = each(%$node))
+ {
+ if ($key eq '__text__')
+ {
+ printf("%stext '%s'\n", $indentation, $value);
+ }
+ elsif ($key eq '__attributes__')
+ {
+ next;
+ }
+ elsif (ref($value) eq "ARRAY")
+ {
+ foreach my $item (@$value)
+ {
+ printf("%s%s {\n", $indentation, $key);
+ PrintNode($indentation." ", $item);
+ printf("%s}\n", $indentation);
+ }
+ }
+ else
+ {
+ printf("%s%s {\n", $indentation, $key);
+ PrintNode($indentation." ", $value);
+ printf("%s}\n", $indentation);
+ }
+ }
+}
+
+
+sub HandleStartTag ($$$@)
+{
+ my ($data, $expat, $element, @attributes) = @_;
+
+ # Create new node with attributes.
+ my $node = {'__attributes__' => {@attributes}};
+
+ # Append it to the list of $element objects.
+ my $current_node = $data->{'current_node'};
+ $current_node->{$element} = [] unless defined $current_node->{$element};
+ push @{$current_node->{$element}}, $node;
+
+ # Make the new node the current node.
+ push @{$data->{'node_stack'}}, $current_node;
+ $data->{'current_node'} = $node;
+}
+
+sub HandleEndTag ($$$)
+{
+ my ($data, $expat, $element) = @_;
+
+ # Restore the parent node as current node.
+ $data->{'current_node'} = pop @{$data->{'node_stack'}};
+}
+
+sub HandleText ($$$)
+{
+ my ($data, $expat, $text) = @_;
+ if ($text !~ /^\s*$/)
+ {
+ $data->{'current_node'}->{'__text__'} .= $text;
+ }
+}
+
+=head2 Read($self, $filename)
+
+ Read the releases.xml file as doctree and parse its content.
+
+=cut
+sub Read ($$)
+{
+ my ($self, $filename) = @_;
+
+ my $document = ReadDomTree($filename);
+ foreach my $release_node (@{$document->{'releases'}->[0]->{'release'}})
+ {
+ my $version_node = GetFirstChild($release_node, "version");
+ my $version_major = GetText(GetFirstChild($version_node, "major"));
+ my $version_minor = GetText(GetFirstChild($version_node, "minor"), "0");
+ my $version_micro = GetText(GetFirstChild($version_node, "micro"), "0");
+ my $version = sprintf("%d.%d.%d", $version_major, $version_minor, $version_micro);
+ die "could not read version from releases.xml" if $version eq "";
+
+ push @{$self->{'releases'}}, $version;
+
+ my $download_node = GetFirstChild($release_node, "downloads");
+ my $package_format = GetText(GetFirstChild($download_node, "package-format"));
+ my $url_template = GetText(GetFirstChild($download_node, "url-template"));
+ my $upgrade_code = GetText(GetFirstChild($download_node, "upgrade-code"));
+ my $build_id = GetText(GetFirstChild($download_node, "build-id"));
+ die "could not read package format from releases.xml" if $package_format eq "";
+
+ $self->{$version}->{$package_format}->{'upgrade-code'} = $upgrade_code;
+ $self->{$version}->{$package_format}->{'build-id'} = $build_id;
+
+ foreach my $item_node (@{$download_node->{'item'}})
+ {
+ my ($language, $download_data) = ParseDownloadData($item_node, $url_template);
+ if (defined $download_data && defined $language)
+ {
+ $self->{$version}->{$package_format}->{$language} = $download_data;
+ }
+ }
+ }
+}
+
+
+
+
+=head2 ParseDownloadData ($download_node)
+
+ Parse the data for one set of download data (there is one per release and package format).
+
+=cut
+sub ParseDownloadData ($$)
+{
+ my ($item_node, $url_template) = @_;
+
+ my $language = GetText(GetFirstChild($item_node, "language"));
+ my $checksum_node = GetFirstChild($item_node, "checksum");
+ if ( ! defined $checksum_node)
+ {
+ print STDERR "releases data file corrupt (item has no 'checksum' node)\n";
+ return undef;
+ }
+ my $checksum_type = GetAttribute($checksum_node, "type");
+ my $checksum_value = GetText($checksum_node);
+ my $file_size = GetText(GetFirstChild($item_node, "size"));
+ my $product_code = GetText(GetFirstChild($item_node, "product-code"));
+
+ my $url = $url_template;
+ $url =~ s/\%L/$language/g;
+ return (
+ $language,
+ {
+ 'URL' => $url,
+ 'checksum-type' => $checksum_type,
+ 'checksum-value' => $checksum_value,
+ 'file-size' => $file_size,
+ 'product-code' => $product_code
+ });
+}
+
+
+
+
+=head2 GetPreviousVersion($version)
+
+ Look up $version in the sorted list of released versions. Return
+ the previous element. Whe $version is not found then return the
+ last element (under the assumption that $version will be the next
+ released version).
+
+=cut
+sub GetPreviousVersion ($)
+{
+ my ($current_version) = @_;
+
+ my $release_data = installer::patch::ReleasesList::Instance();
+ my $previous_version = undef;
+ foreach my $version (@{$release_data->{'releases'}})
+ {
+ if ($version eq $current_version)
+ {
+ return $previous_version;
+ }
+ else
+ {
+ $previous_version = $version;
+ }
+ }
+
+ return $previous_version;
+}
+
+
+
+
+
+1;
Modified: openoffice/trunk/main/solenv/bin/modules/installer/patch/Tools.pm
URL: http://svn.apache.org/viewvc/openoffice/trunk/main/solenv/bin/modules/installer/patch/Tools.pm?rev=1547732&r1=1547731&r2=1547732&view=diff
==============================================================================
--- openoffice/trunk/main/solenv/bin/modules/installer/patch/Tools.pm (original)
+++ openoffice/trunk/main/solenv/bin/modules/installer/patch/Tools.pm Wed Dec 4 08:51:30 2013
@@ -1,47 +1,62 @@
-#**************************************************************
-#
-# Licensed to the Apache Software Foundation (ASF) under one
-# or more contributor license agreements. See the NOTICE file
-# distributed with this work for additional information
-# regarding copyright ownership. The ASF licenses this file
-# to you under the Apache License, Version 2.0 (the
-# "License"); you may not use this file except in compliance
-# with the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing,
-# software distributed under the License is distributed on an
-# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
-# KIND, either express or implied. See the License for the
-# specific language governing permissions and limitations
-# under the License.
-#
-#**************************************************************
-
-package installer::patch::Tools;
-
-=head1 NAME
-
- package installer::patch::Tools - Collection of functions that don't fit anywhere else
-
-=cut
-
-
-
-
-=head2 CygpathToWindows ($path)
-
- Convert the given path with the 'cygpath' command into Windows format. Quote backslashes.
-
-=cut
-sub CygpathToWindows($)
-{
- my ($path) = @_;
- my $windows_path = qx(cygpath -w "$path");
- $windows_path =~ s/(^\s+|\s+$)//g;
- $windows_path =~ s/\\/\\\\/g;
- return $windows_path;
-}
-
-1;
+#**************************************************************
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+#**************************************************************
+
+package installer::patch::Tools;
+
+=head1 NAME
+
+ package installer::patch::Tools - Collection of functions that don't fit anywhere else
+
+=cut
+
+
+
+
+=head2 ToEscapedWindowsPath ($path)
+
+ Convert the given path with the 'cygpath' command into Windows format. Quote backslashes.
+
+=cut
+sub ToEscapedWindowsPath($)
+{
+ my ($path) = @_;
+
+ my $windows_path = qx(cygpath -w "$path");
+ $windows_path =~ s/(^\s+|\s+$)//g;
+ $windows_path =~ s/\\/\\\\/g;
+
+ return $windows_path;
+}
+
+
+
+
+sub ToWindowsPath ($)
+{
+ my ($path) = @_;
+
+ my $windows_path = qx(cygpath -w "$path");
+ $windows_path =~ s/(^\s+|\s+$)//g;
+
+ return $windows_path;
+}
+
+1;
Modified: openoffice/trunk/main/solenv/bin/modules/installer/patch/Version.pm
URL: http://svn.apache.org/viewvc/openoffice/trunk/main/solenv/bin/modules/installer/patch/Version.pm?rev=1547732&r1=1547731&r2=1547732&view=diff
==============================================================================
--- openoffice/trunk/main/solenv/bin/modules/installer/patch/Version.pm (original)
+++ openoffice/trunk/main/solenv/bin/modules/installer/patch/Version.pm Wed Dec 4 08:51:30 2013
@@ -35,7 +35,7 @@ my $VersionPartCount = 3;
-=head StringToNumberArray($version_string)
+=head2 StringToNumberArray($version_string)
Convert a version string (where the individual parts are separated by '.') into an array of three numbers.
Missing numbers are filled with 0.
@@ -57,7 +57,7 @@ sub StringToNumberArray ($)
-=head ArrayToDirectoryName (@)
+=head2 ArrayToDirectoryName (@)
Return a directory name (without any path) for the given array of version numbers.
@@ -69,6 +69,37 @@ sub ArrayToDirectoryName (@)
+=head2 ArrayToNoDotName (@)
+
+ This symply creates a version array (A,B,C) into a version string
+ "ABC" with no dots between major, minor and micro version number.
+
+=cut
+sub ArrayToNoDotName (@)
+{
+ return join("", @_);
+}
+
+
+
+
+=head2 IsMajorVersion ($version_string)
+
+ Return 1 if $version_string is a major version, ie. ?.0.0
+ Return 0 otherwise.
+
+=cut
+sub IsMajorVersion ($)
+{
+ my ($version_string) = @_;
+ my @version = installer::patch::Version::StringToNumberArray($version_string);
+ for (my $index=1; $index<$VersionPartCount; ++$index)
+ {
+ return 0 if $version[$index] ne "0";
+ }
+ return 1;
+}
+
1;
Modified: openoffice/trunk/main/solenv/bin/modules/installer/systemactions.pm
URL: http://svn.apache.org/viewvc/openoffice/trunk/main/solenv/bin/modules/installer/systemactions.pm?rev=1547732&r1=1547731&r2=1547732&view=diff
==============================================================================
--- openoffice/trunk/main/solenv/bin/modules/installer/systemactions.pm (original)
+++ openoffice/trunk/main/solenv/bin/modules/installer/systemactions.pm Wed Dec 4 08:51:30 2013
@@ -1710,36 +1710,48 @@ sub read_complete_directory
# Version 2
##############################################################
-sub read_full_directory {
+sub read_full_directory ($$$)
+{
my ( $currentdir, $pathstring, $collector ) = @_;
my $item;
my $fullname;
local *DH;
- unless (opendir(DH, $currentdir))
- {
- return;
- }
- while (defined ($item = readdir(DH)))
- {
- next if($item eq "." or $item eq "..");
- $fullname = $currentdir . $installer::globals::separator . $item;
- my $sep = "";
- if ( $pathstring ne "" ) { $sep = $installer::globals::separator; }
+ $installer::logger::Lang->printf("seaching files under '%s'\n", $currentdir);
- if( -d $fullname)
- {
- my $newpathstring = $pathstring . $sep . $item;
- read_full_directory($fullname, $newpathstring, $collector) if(-d $fullname);
- }
- else
- {
- my $content = $pathstring . $sep . $item;
- push(@{$collector}, $content);
- }
- }
- closedir(DH);
- return
+ my @directory_queue = [$currentdir, $pathstring];
+
+ while (scalar @directory_queue > 0)
+ {
+ my ($path, $relative_path) = @{shift @directory_queue};
+ my $start_count = scalar @$collector;
+
+ next unless opendir(DH, $path);
+
+ while (defined ($item = readdir(DH)))
+ {
+ next if($item eq "." or $item eq "..");
+ $fullname = $path . $installer::globals::separator . $item;
+ my $sep = "";
+ if ($relative_path ne "")
+ {
+ $sep = $installer::globals::separator;
+ }
+
+ if( -d $fullname)
+ {
+ push @directory_queue, [$fullname, $relative_path . $sep . $item];
+ }
+ else
+ {
+ my $content = $relative_path . $sep . $item;
+ push(@{$collector}, $content);
+ }
+ }
+ closedir(DH);
+ my $count = scalar @$collector - $start_count;
+ $installer::logger::Lang->printf(" found %d new files in '%s'\n", $count, $path);
+ }
}
##############################################################
Modified: openoffice/trunk/main/solenv/bin/modules/installer/windows/component.pm
URL: http://svn.apache.org/viewvc/openoffice/trunk/main/solenv/bin/modules/installer/windows/component.pm?rev=1547732&r1=1547731&r2=1547732&view=diff
==============================================================================
--- openoffice/trunk/main/solenv/bin/modules/installer/windows/component.pm (original)
+++ openoffice/trunk/main/solenv/bin/modules/installer/windows/component.pm Wed Dec 4 08:51:30 2013
@@ -358,70 +358,272 @@ sub get_component_keypath ($$)
"get_component_keypath");
}
-###################################################################
-# Creating the file Componen.idt dynamically
-# Content:
-# Component ComponentId Directory_ Attributes Condition KeyPath
-###################################################################
-sub create_component_table ($$$$$$$)
+
+
+sub remove_ooversion_from_component_name($)
{
- my ($filesref,
- $registryref,
- $dirref,
- $allfilecomponentsref,
- $allregistrycomponents,
- $basedir,
- $allvariables)
- = @_;
+ my ($component_name) = @_;
- my @componenttable = ();
+ $component_name =~ s/_openoffice\d+//;
- my ($oneline, $infoline);
+ return $component_name;
+}
- installer::windows::idtglobal::write_idt_header(\@componenttable, "component");
- # collect_layer_conditions();
- # File components
+sub prepare_component_table_creation ($$$)
+{
+ my ($file_components, $registry_components, $variables) = @_;
+
+ if ($installer::globals::is_release)
+ {
+ my %source_component_data = ();
+
+ # Collect the components that are used in the source release.
+ my $component_table = $installer::globals::source_msi->GetTable("Component");
+ foreach my $row (@{$component_table->GetAllRows()})
+ {
+ $source_component_data{$row->GetValue("Component")} = $row;
+ }
+
+ # Find source components that do not exist in the target components, ie have been removed.
+
+ # Process file components.
+ my @missing_source_component_names = ();
+ my %file_component_hash = map {$_ => 1} @$file_components;
+ foreach my $source_component_name (keys %source_component_data)
+ {
+ # In this loop we only process components for files and ignore those for registry entries.
+ next if $source_component_name =~ /^registry_/;
+
+ if ( ! defined $file_component_hash{$source_component_name})
+ {
+ push @missing_source_component_names, [$source_component_name, $source_component_name];
+ $installer::logger::Info->printf("missing file component %s\n", $source_component_name);
+ }
+ }
+
+ # Process registry components.
+ my %registry_component_hash = map {$_ => 1} @$registry_components;
+ my %registry_component_hash_normalized = map {remove_ooversion_from_component_name($_) => $_} @$registry_components;
+ my %target_registry_component_translation = ();
+ foreach my $source_component_name (keys %source_component_data)
+ {
+ # In this loop we only process components for registry entries and ignore those for files.
+ next if $source_component_name !~ /^registry_/;
+
+ if (defined $registry_component_hash{$source_component_name})
+ {
+ # Found the non-normalized name.
+ }
+ elsif (defined $registry_component_hash_normalized{
+ remove_ooversion_from_component_name($source_component_name)})
+ {
+ # Found the normalized name.
+ my $target_component_name = $registry_component_hash_normalized{
+ remove_ooversion_from_component_name($source_component_name)};
+ $target_registry_component_translation{$target_component_name} = $source_component_name;
+ $installer::logger::Info->printf("found normalized component name %s\n", $source_component_name);
+ $installer::logger::Info->printf(" %s -> %s\n", $target_component_name, $source_component_name);
+ }
+ else
+ {
+ # Source component was not found.
+ push @missing_source_component_names, $source_component_name;
+ $installer::logger::Info->printf("missing component %s\n", $source_component_name);
+ }
+ }
+
+ if (scalar @missing_source_component_names > 0)
+ {
+ $installer::logger::Info->printf("Error: there are %d missing components\n",
+ scalar @missing_source_component_names);
+ return {};
+ }
+ else
+ {
+ return \%target_registry_component_translation;
+ }
+ }
+
+ return {};
+}
+
+
- for ( my $i = 0; $i <= $#{$allfilecomponentsref}; $i++ )
+
+sub get_component_data ($$$$)
+{
+ my ($file_component_names,
+ $registry_component_names,
+ $files,
+ $registry_entries) = @_;
+
+ # When we are building a release then prepare building a patch by looking up some data
+ # from the previous release.
+ my %source_data = ();
+ if ($installer::globals::is_release)
+ {
+ my $source_component_table = $installer::globals::source_msi->GetTable("Component");
+ my $component_column_index = $source_component_table->GetColumnIndex("Component");
+ my $component_id_column_index = $source_component_table->GetColumnIndex("ComponentId");
+ my $key_path_column_index = $source_component_table->GetColumnIndex("KeyPath");
+ foreach my $source_row (@{$source_component_table->GetAllRows()})
+ {
+ my $component_name = $source_row->GetValue($component_column_index);
+ my $component_id = $source_row->GetValue($component_id_column_index);
+ my $key_path = $source_row->GetValue($key_path_column_index);
+
+ $source_data{$component_name} = {
+ 'component_id' => $component_id,
+ 'key_path' => $key_path
+ };
+ }
+ }
+
+ # Set up data for the target release.
+ # Use data from the source version where possible.
+ # Create missind data where necessary.
+
+ # Set up the target data with flags that remember whether a
+ # component contains files or registry entries.
+ my %target_data = ();
+ foreach my $name (@$file_component_names)
+ {
+ $target_data{$name} = {'is_file' => 1};
+ }
+ foreach my $name (@$registry_component_names)
+ {
+ $target_data{$name} = {'is_file' => 0};
+ }
+
+ # Add values for the ComponentId column.
+ $installer::logger::Lang->printf("preparing Component->ComponentId values\n");
+ foreach my $name (@$file_component_names,@$registry_component_names)
+ {
+ # Determine the component id.
+ my $guid = $installer::globals::is_release
+ ? $source_data{$name}->{'component_id'}
+ : undef;
+ if (defined $guid)
+ {
+ $installer::logger::Lang->printf(" reusing guid %s\n", $guid);
+ }
+ else
+ {
+ $guid = installer::windows::msiglobal::create_guid();
+ $installer::logger::Lang->printf(" creating new guid %s\n", $guid);
+ }
+ $target_data{$name}->{'component_id'} = $guid;
+ }
+
+ # Add values for the KeyPath column.
+ $installer::logger::Lang->printf("preparing Component->KeyPath values\n");
+ foreach my $name (@$file_component_names,@$registry_component_names)
+ {
+ # Determine the key path.
+ my $key_path = $installer::globals::is_release
+ ? $source_data{$name}->{'key_path'}
+ : undef;
+ if (defined $key_path)
+ {
+ $installer::logger::Lang->printf(" reusing key path %s\n", $key_path);
+ }
+ else
+ {
+ if ($target_data{$name}->{'is_file'})
+ {
+ $key_path = get_component_keypath($name, $files);
+ }
+ else
+ {
+ $key_path = get_component_keypath($name, $registry_entries);
+ }
+ }
+ $target_data{$name}->{'key_path'} = $key_path;
+ }
+
+ return \%target_data;
+}
+
+
+
+
+sub create_component_table_data ($$$$$$)
+{
+ my ($filesref, $registryref, $dirref, $allfilecomponentsref, $allregistrycomponents, $allvariables) = @_;
+
+ my $target_data = get_component_data($allfilecomponentsref, $allregistrycomponents, $filesref, $registryref);
+
+ my @table_data = ();
+
+ # File components
+ foreach my $name (@$allfilecomponentsref)
{
my %onecomponent = ();
- $onecomponent{'name'} = ${$allfilecomponentsref}[$i];
- $onecomponent{'guid'} = get_component_guid($onecomponent{'name'});
- $onecomponent{'directory'} = get_file_component_directory($onecomponent{'name'}, $filesref, $dirref);
+ $onecomponent{'name'} = $name;
+ $onecomponent{'guid'} = $target_data->{$name}->{'component_id'};
+ $onecomponent{'directory'} = get_file_component_directory($name, $filesref, $dirref);
if ( $onecomponent{'directory'} eq "IGNORE_COMP" ) { next; }
- $onecomponent{'attributes'} = get_file_component_attributes($onecomponent{'name'}, $filesref, $allvariables);
- $onecomponent{'condition'} = get_file_component_condition($onecomponent{'name'}, $filesref);
- $onecomponent{'keypath'} = get_component_keypath($onecomponent{'name'}, $filesref);
+ $onecomponent{'attributes'} = get_file_component_attributes($name, $filesref, $allvariables);
+ $onecomponent{'condition'} = get_file_component_condition($name, $filesref);
+ $onecomponent{'keypath'} = $target_data->{$name}->{'key_path'};
- $oneline = $onecomponent{'name'} . "\t" . $onecomponent{'guid'} . "\t" . $onecomponent{'directory'} . "\t"
- . $onecomponent{'attributes'} . "\t" . $onecomponent{'condition'} . "\t" . $onecomponent{'keypath'} . "\n";
-
- push(@componenttable, $oneline);
+ push @table_data, \%onecomponent;
}
# Registry components
-
- for ( my $i = 0; $i <= $#{$allregistrycomponents}; $i++ )
+ foreach my $name (@$allregistrycomponents)
{
my %onecomponent = ();
-
- $onecomponent{'name'} = ${$allregistrycomponents}[$i];
- $onecomponent{'guid'} = get_component_guid($onecomponent{'name'});
+
+ $onecomponent{'name'} = $name;
+ $onecomponent{'guid'} = $target_data->{$name}->{'component_id'};
$onecomponent{'directory'} = get_registry_component_directory();
- $onecomponent{'attributes'} = get_registry_component_attributes($onecomponent{'name'}, $allvariables);
- $onecomponent{'condition'} = get_component_condition($onecomponent{'name'});
- $onecomponent{'keypath'} = get_component_keypath($onecomponent{'name'}, $registryref);
+ $onecomponent{'attributes'} = get_registry_component_attributes($name, $allvariables);
+ $onecomponent{'condition'} = get_component_condition($name);
+ $onecomponent{'keypath'} = $target_data->{$name}->{'key_path'};
- $oneline = $onecomponent{'name'} . "\t" . $onecomponent{'guid'} . "\t" . $onecomponent{'directory'} . "\t"
- . $onecomponent{'attributes'} . "\t" . $onecomponent{'condition'} . "\t" . $onecomponent{'keypath'} . "\n";
+ push(@table_data, \%onecomponent);
+ }
+ return \@table_data;
+}
+
+
+
+
+###################################################################
+# Creating the file Componen.idt dynamically
+# Content:
+# Component ComponentId Directory_ Attributes Condition KeyPath
+###################################################################
+
+
+sub create_component_table ($$)
+{
+ my ($table_data, $basedir) = @_;
+
+ my @componenttable = ();
+
+ my ($oneline, $infoline);
+
+ installer::windows::idtglobal::write_idt_header(\@componenttable, "component");
+
+ foreach my $item (@$table_data)
+ {
+ $oneline = sprintf("%s\t%s\t%s\t%s\t%s\t%s\n",
+ $item->{'name'},
+ $item->{'guid'},
+ $item->{'directory'},
+ $item->{'attributes'},
+ $item->{'condition'},
+ $item->{'keypath'});
push(@componenttable, $oneline);
- }
+ }
# Saving the file
@@ -431,6 +633,9 @@ sub create_component_table ($$$$$$$)
$installer::logger::Lang->print($infoline);
}
+
+
+
####################################################################################
# Returning a component for a scp module gid.
# Pairs are saved in the files collector.
@@ -513,4 +718,29 @@ sub set_component_in_environment_table
}
}
+
+
+
+sub apply_component_translation ($@)
+{
+ my ($translation_map, @component_names) = @_;
+
+ my @translated_names = ();
+ foreach my $component_name (@component_names)
+ {
+ my $translated_name = $translation_map->{$component_name};
+ if (defined $translated_name)
+ {
+ push @translated_names, $translated_name;
+ }
+ else
+ {
+ push @translated_names, $component_name;
+ }
+ }
+
+ return @translated_names;
+}
+
+
1;