You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@openoffice.apache.org by or...@apache.org on 2013/12/18 14:27:25 UTC
svn commit: r1551937 [16/29] - in /openoffice/branches/ooxml-osba: ./
extras/l10n/source/bg/ extras/l10n/source/de/ extras/l10n/source/nb/
extras/l10n/source/th/ main/ main/accessibility/inc/accessibility/extended/
main/accessibility/inc/accessibility/...
Modified: openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/Msi.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/Msi.pm?rev=1551937&r1=1551936&r2=1551937&view=diff
==============================================================================
--- openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/Msi.pm (original)
+++ openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/Msi.pm Wed Dec 18 13:27:09 2013
@@ -1,342 +1,509 @@
-#**************************************************************
-#
-# 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,
+ installer::languages::get_normalized_language($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);
+
+ # Fill in some missing values from the 'Properties' table.
+ if ( ! (defined $version && defined $language && defined $product_name))
+ {
+ my $property_table = $self->GetTable("Property");
+
+ $self->{'version'} = $property_table->GetValue("Property", "DEFINEDVERSION", "Value")
+ unless defined $self->{'version'};
+ $self->{'product_name'} = $property_table->GetValue("Property", "DEFINEDPRODUCT", "Value")
+ unless defined $self->{'product_name'};
+
+ my $language = $property_table->GetValue("Property", "ProductLanguage", "Value");
+ # TODO: Convert numerical language id to language name.
+ $self->{'language'} = $language
+ unless defined $self->{'language'};
+ }
+
+ 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);
+ }
+
+ # 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);
+ }
+}
+
+
+
+
+sub SetupFullNames ($$);
+sub SetupFullNames ($$)
+{
+ my ($item, $directory_map) = @_;
+
+ # Don't process any item twice.
+ return if defined $item->{'full_source_name'};
+
+ my $parent = $item->{'parent'};
+ if (defined $parent)
+ {
+ # Process the parent first.
+ if ( ! defined $parent->{'full_source_long_name'})
+ {
+ SetupFullNames($parent, $directory_map);
+ }
+
+ # Prepend the full names of the parent to our names.
+ $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
+ {
+ # 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'};
+ }
+}
+
+
+
+
+=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'};
+ }
+
+ # Initialize the directory map.
+ my $directory_table = $self->GetTable("Directory");
+ my $directory_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");
+ $directory_map->{$unique_name} =
+ {
+ 'unique_name' => $unique_name,
+ 'parent_name' => $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
+ };
+ }
+
+ # Add references to parent directories.
+ foreach my $item (values %$directory_map)
+ {
+ $item->{'parent'} = $directory_map->{$item->{'parent_name'}};
+ }
+
+ # Set up full names for all directories.
+ foreach my $item (values %$directory_map)
+ {
+ SetupFullNames($item, $directory_map);
+ }
+
+ # Cleanup the names.
+ foreach my $item (values %$directory_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'} = $directory_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");
+ my $file_filename_index = $file_table->GetColumnIndex("FileName");
+ 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);
+ my $file_name = $file_row->GetValue($file_filename_index);
+ my ($long_name, $short_name) = SplitLongShortName($file_name);
+ $file_map->{$unique_name} = {
+ 'directory' => $dir_map->{$directory_name},
+ 'component_name' => $component_name,
+ 'file_name' => $file_name,
+ 'long_name' => $long_name,
+ 'short_name' => $short_name
+ };
+ }
+
+ $self->{'FileMap'} = $file_map;
+ return $file_map;
+}
+
+
+1;
Modified: openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/MsiRow.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/MsiRow.pm?rev=1551937&r1=1551936&r2=1551937&view=diff
==============================================================================
--- openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/MsiRow.pm (original)
+++ openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/MsiRow.pm Wed Dec 18 13:27:09 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/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/MsiTable.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/MsiTable.pm?rev=1551937&r1=1551936&r2=1551937&view=diff
==============================================================================
--- openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/MsiTable.pm (original)
+++ openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/MsiTable.pm Wed Dec 18 13:27:09 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/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/ReleasesList.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/ReleasesList.pm?rev=1551937&r1=1551936&r2=1551937&view=diff
==============================================================================
--- openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/ReleasesList.pm (original)
+++ openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/ReleasesList.pm Wed Dec 18 13:27:09 2013
@@ -1,210 +1,546 @@
-#**************************************************************
-#
-# 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($$);
+
+=head2 ReadDomTree ($filename)
+
+ Read the dom tree for the XML in $filename.
+
+ Note that
+ a) this was initially written for another XML library that provided the dom tree directly.
+ b) the dom tree creation is basic and simple but good enough for the current format.
+ When the format should change substantially, then we may need a better parser.
+
+=cut
+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;
+}
+
+
+
+
+=head HandleStartTag ($data, $expat, $element_name, @attributes)
+
+ Callback for start tags.
+
+ A new hash is appended to the array that is referenced by the parent by $element_name.
+ That means that when this function ends there the new hash can be referenced by
+ my $parent = $data->{'node_stack'}->[-1];
+ my $new_hash = $parent->{$element_name}->[-1];
+
+ Note that, just like in other implementations of dom trees,
+ $parent->{$element_name} is an array, even when there is only one
+ element.
+
+ The new hash is empty or contains the given @attributes as hash.
+ When fully read (ie its end tag has been processed) then it can contain two special keys:
+ __attributes__ for the attributes
+ __text__ for the concatenated text parts
+
+=cut
+sub HandleStartTag ($$$@)
+{
+ my ($data, $expat, $element_name, @attributes) = @_;
+
+ # Create new node with attributes.
+ my $node = {'__attributes__' => {@attributes}};
+
+ # Append it to the list of $element_name objects.
+ my $current_node = $data->{'current_node'};
+ $current_node->{$element_name} = [] unless defined $current_node->{$element_name};
+ push @{$current_node->{$element_name}}, $node;
+
+ # Make the new node the current node.
+ push @{$data->{'node_stack'}}, $current_node;
+ $data->{'current_node'} = $node;
+}
+
+=head HandleEndTag ($data, $expat, $element_name, @attributes)
+
+ Callback for end tags.
+
+=cut
+sub HandleEndTag ($$$)
+{
+ my ($data, $expat, $element) = @_;
+
+ # Restore the parent node as current node.
+ $data->{'current_node'} = pop @{$data->{'node_stack'}};
+}
+
+=head2 HandleText ($data, $expat, $text)
+
+ Callback for text.
+
+ $text is appended to the __text__ member of the current node in
+ the dom tree.
+
+=cut
+sub HandleText ($$$)
+{
+ my ($data, $expat, $text) = @_;
+ if ($text !~ /^\s*$/)
+ {
+ $data->{'current_node'}->{'__text__'} .= $text;
+ }
+}
+
+
+
+
+=head2 PrintNode ($indentation, $node)
+
+ For debugging.
+ Print $node recursively with initial $indentation.
+
+=cut
+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);
+ }
+ }
+}
+
+
+
+
+=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;
+ $self->{$version}->{$package_format}->{'url-template'} = $url_template;
+
+ my @languages = ();
+ foreach my $item_node (@{$download_node->{'item'}})
+ {
+ my ($language, $download_data) = ParseDownloadData($item_node, $url_template);
+ if (defined $download_data && defined $language)
+ {
+ push @languages, $language;
+ $self->{$version}->{$package_format}->{$language} = $download_data;
+ }
+ }
+ $self->{$version}->{$package_format}->{'languages'} = \@languages;
+ }
+}
+
+
+
+
+=head2 ParseDownloadData ($item_node, $url_template)
+
+ 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 Write($self, $filename)
+
+ Write the content of the releases data to a file named $filename.
+
+=cut
+sub Write ($$)
+{
+ my ($self, $filename) = @_;
+
+ open my $out, ">", $filename || die "can not write releases data to ".$filename;
+ $self->WriteHeader($out);
+ $self->WriteContent($out);
+ close $out;
+}
+
+
+
+
+=head2 WriteContent ($self, $out)
+
+ Write the content of the releases.xml list.
+
+=cut
+sub WriteContent ($$)
+{
+ my ($self, $out) = @_;
+
+ print $out "<releases>\n";
+ # Write the data sets for each releases with the same sort order as @{$self->{'releases'}}
+ foreach my $version (@{$self->{'releases'}})
+ {
+ print $out " <release>\n";
+
+ my @version_array = split(/\./, $version);
+ printf $out " <version>\n";
+ printf $out " <major>%s</major>\n", $version_array[0];
+ printf $out " <minor>%s</minor>\n", $version_array[1];
+ printf $out " <micro>%s</micro>\n", $version_array[2];
+ printf $out " </version>\n";
+
+ # Write one download data set per package format.
+ while (my ($package_format, $data) = each %{$self->{$version}})
+ {
+ print $out " <download>\n";
+ printf $out " <package-format>%s</package-format>\n", $package_format;
+ print $out " <url-template>\n";
+ printf $out " %s\n", $data->{'url-template'};
+ print $out " </url-template>\n";
+ printf $out " <upgrade-code>%s</upgrade-code>\n", $data->{'upgrade-code'};
+ printf $out " <build-id>%s</build-id>\n", $data->{'build-id'};
+
+ foreach my $language (@{$data->{'languages'}})
+ {
+ my $language_data = $data->{$language};
+ print $out " <item>\n";
+ printf $out " <language>%s</language>\n", $language;
+ printf $out " <checksum type=\"%s\">%s</checksum>\n",
+ $language_data->{'checksum-type'},
+ $language_data->{'checksum-value'};
+ printf $out " <size>%s</size>\n", $language_data->{'file-size'};
+ printf $out " <product-code>%s</product-code>\n", $language_data->{'product-code'};
+ print $out " </item>\n";
+ }
+
+ print $out " </download>\n";
+ }
+
+ print $out " </release>\n";
+ }
+
+ print $out "</releases>\n";
+}
+
+
+
+
+=head2 WriteHeader ($self, $out)
+
+ Write the header for the releases.xml list.
+
+=cut
+sub WriteHeader ($$)
+{
+ my ($self, $out) = @_;
+
+print $out <<EOT;
+<?xml version='1.0' encoding='UTF-8'?>
+<!--***********************************************************
+ *
+ * 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.
+ *
+ ***********************************************************-->
+EOT
+}
+
+
+
+
+=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/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/Tools.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/Tools.pm?rev=1551937&r1=1551936&r2=1551937&view=diff
==============================================================================
--- openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/Tools.pm (original)
+++ openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/Tools.pm Wed Dec 18 13:27:09 2013
@@ -1,47 +1,76 @@
-#**************************************************************
-#
-# 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;
+}
+
+
+# TODO: Is there a touch in a standard library?
+sub touch ($)
+{
+ my ($filename) = @_;
+
+ open my $out, ">", $filename;
+ close $out;
+}
+
+
+
+
+
+1;
Modified: openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/Version.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/Version.pm?rev=1551937&r1=1551936&r2=1551937&view=diff
==============================================================================
--- openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/Version.pm (original)
+++ openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/patch/Version.pm Wed Dec 18 13:27:09 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/branches/ooxml-osba/main/solenv/bin/modules/installer/pathanalyzer.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/pathanalyzer.pm?rev=1551937&r1=1551936&r2=1551937&view=diff
==============================================================================
--- openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/pathanalyzer.pm (original)
+++ openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/pathanalyzer.pm Wed Dec 18 13:27:09 2013
@@ -46,6 +46,14 @@ sub get_path_from_fullqualifiedname
}
}
+
+
+
+=head2
+
+ Despite its name, this function seems just to return the basename of the given filename.
+
+=cut
sub make_absolute_filename_to_relative_filename
{
my ($longfilenameref) = @_;
Modified: openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/scppatchsoname.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/scppatchsoname.pm?rev=1551937&r1=1551936&r2=1551937&view=diff
==============================================================================
--- openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/scppatchsoname.pm (original)
+++ openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/scppatchsoname.pm Wed Dec 18 13:27:09 2013
@@ -94,37 +94,18 @@ sub replace_productname_in_file
my $replacestring = "";
for ( my $i = 1; $i <= 80; $i++ ) { $replacestring .= $onestring; }
+ $installer::logger::Lang->printf("processing PATCH_SO_NAME: %s -> %s\n", $sourcepath, $destpath);
+
my $productname = $variableshashref->{'PRODUCTNAME'} . " " . $variableshashref->{'PRODUCTVERSION'};
if ( exists($onefilehash->{'FileDescription'}) ) { $productname = $onefilehash->{'FileDescription'}; }
my $unicode_productname = convert_to_unicode($productname);
change_length_of_string(\$unicode_productname, $replacestring);
- my $found1 = $onefile =~ s/$replacestring/$unicode_productname/sg;
-
- my $found2 = 0;
-
- if ( $styles =~ /\bPATCH_SO_NAME_Z\b/ )
- {
- # searching for "z"
-
- $onestring = "z" . chr(0);
- $replacestring = "";
- for ( my $i = 1; $i <= 80; $i++ ) { $replacestring .= $onestring; }
-
- my $productname2 = $variableshashref->{'PRODUCTNAME'} . " " . $variableshashref->{'PRODUCTVERSION'};
- if ( exists($onefilehash->{'FileDescriptionZ'}) ) { $productname2 = $onefilehash->{'FileDescriptionZ'}; }
- my $unicode_productname2 = convert_to_unicode($productname2);
-
- change_length_of_string_with_letter(\$unicode_productname2, $replacestring, $onestring);
-
- $found2 = $onefile =~ s/$replacestring/$unicode_productname2/sg;
- }
+ my $found = $onefile =~ s/$replacestring/$unicode_productname/sg;
installer::files::save_binary_file($onefile, $destpath);
- my $found = $found1 + $found2;
-
return $found;
}
@@ -173,7 +154,8 @@ sub resolving_patchsoname_flag
# if (!(-f $destinationpath)) # do nothing if the file already exists
# {
-
+
+ $installer::logger::Lang->printf("PATCH_SO_NAME: copying '%s' to '%s'\n", $sourcepath, $movepath);
my $copysuccess = installer::systemactions::copy_one_file($sourcepath, $movepath);
if ( $copysuccess )
Modified: openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/scpzipfiles.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/scpzipfiles.pm?rev=1551937&r1=1551936&r2=1551937&view=diff
==============================================================================
--- openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/scpzipfiles.pm (original)
+++ openoffice/branches/ooxml-osba/main/solenv/bin/modules/installer/scpzipfiles.pm Wed Dec 18 13:27:09 2013
@@ -29,29 +29,35 @@ use installer::logger;
use installer::pathanalyzer;
use installer::systemactions;
+use strict;
+
########################################################################################
# Replacing all zip list variables in setup script and files with flag scpzip_replace
########################################################################################
-sub replace_all_ziplistvariables_in_file
+sub replace_all_ziplistvariables_in_file ($$)
{
- my ( $fileref, $variableshashref ) = @_;
+ my ($lines, $variables) = @_;
- for ( my $i = 0; $i <= $#{$fileref}; $i++ )
+ my $count = scalar @$lines;
+ for (my $lineno=0; $lineno<$count; ++$lineno)
{
- my $line = ${$fileref}[$i];
-
- if ( $line =~ /^.*\$\{\w+\}.*$/ ) # only occurence of ${abc}
- {
- my $key;
-
- foreach $key (keys %{$variableshashref})
- {
- my $value = $variableshashref->{$key};
- $key = '${' . $key . '}';
- $line =~ s/\Q$key\E/$value/g;
- ${$fileref}[$i] = $line;
+ my $line = $lines->[$lineno];
+ if ($line =~ /\$\{/) # early rejection of lines that don't need replacements
+ {
+ while (my ($key,$value) = each %$variables)
+ {
+ my $pattern = '${' . $key . '}';
+ my $replacement_count = ($line =~ s/\Q$pattern\E/$value/g);
+ if ($key eq "PRODUCTADDON" && $replacement_count>0)
+ {
+ $installer::logger::Lang->printf(
+ "replaced PRODUCTADDON %d times in line %d\n",
+ $replacement_count,
+ $lineno);
+ }
}
+ $lines->[$lineno] = $line;
}
}
}
@@ -61,39 +67,26 @@ sub replace_all_ziplistvariables_in_file
# the brackets are masked.
########################################################################################
-sub replace_all_ziplistvariables_in_rtffile
+sub replace_all_ziplistvariables_in_rtffile ($$)
{
- my ( $fileref, $variablesref, $onelanguage, $loggingdir ) = @_;
-
- # installer::files::save_file($loggingdir . "license_" . $onelanguage . "_before.rtf", $fileref);
+ my ($lines, $variables) = @_;
- for ( my $i = 0; $i <= $#{$fileref}; $i++ )
+ my $line_count = scalar @$lines;
+ for (my $i=0; $i<=$line_count; ++$i)
{
- my $line = ${$fileref}[$i];
+ my $line = $lines->[$i];
- if ( $line =~ /^.*\$\\\{\w+\\\}.*$/ ) # only occurence of $\{abc\}
- {
- for ( my $j = 0; $j <= $#{$variablesref}; $j++ )
+ if ($line =~ /\$\\\{/) # early rejection of lines without variable references
+ {
+ while (my ($key, $value) = each (%$variables))
{
- my $variableline = ${$variablesref}[$j];
-
- my ($key, $value);
-
- if ( $variableline =~ /^\s*([\w-]+?)\s+(.*?)\s*$/ )
- {
- $key = $1;
- $value = $2;
- $key = '$\{' . $key . '\}';
- }
-
+ my $pattern = '$\{' . $key . '\}';
$line =~ s/\Q$key\E/$value/g;
- ${$fileref}[$i] = $line;
}
+ $lines->[$i] = $line;
}
}
-
- # installer::files::save_file($loggingdir . "license_" . $onelanguage . "_after.rtf", $fileref);
}
#########################################################