You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@openoffice.apache.org by hd...@apache.org on 2013/12/11 09:49:18 UTC
svn commit: r1550072 [5/9] - in /openoffice/branches/rejuvenate01: ./
main/accessibility/source/extended/ main/accessibility/source/standard/
main/basic/source/runtime/ main/bridges/prj/
main/chart2/source/controller/dialogs/ main/cui/source/dialogs/ m...
Modified: openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/control.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/control.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/control.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/control.pm Wed Dec 11 08:49:16 2013
@@ -428,16 +428,7 @@ sub determine_ship_directory
my $shipdrive = $ENV{'SHIPDRIVE'};
- my $languagestring = $$languagesref;
-
- if (length($languagestring) > $installer::globals::max_lang_length )
- {
- my $number_of_languages = installer::systemactions::get_number_of_langs($languagestring);
- chomp(my $shorter = `echo $languagestring | md5sum | sed -e "s/ .*//g"`);
- # $languagestring = $shorter;
- my $id = substr($shorter, 0, 8); # taking only the first 8 digits
- $languagestring = "lang_" . $number_of_languages . "_id_" . $id;
- }
+ my $languagestring = installer::languages::get_language_directory_name($$languagesref);
my $productstring = $installer::globals::product;
my $productsubdir = "";
Modified: openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/converter.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/converter.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/converter.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/converter.pm Wed Dec 11 08:49:16 2013
@@ -309,14 +309,13 @@ sub copy_collector
my @newcollector = ();
- for ( my $i = 0; $i <= $#{$oldcollector}; $i++ )
+ foreach my $oldhash (@$oldcollector)
{
my %newhash = ();
- my $key;
- foreach $key (keys %{${$oldcollector}[$i]})
+ while (my ($key, $value) = each %$oldhash)
{
- $newhash{$key} = ${$oldcollector}[$i]->{$key};
+ $newhash{$key} = $value;
}
push(@newcollector, \%newhash);
Modified: openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/globals.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/globals.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/globals.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/globals.pm Wed Dec 11 08:49:16 2013
@@ -31,6 +31,8 @@ BEGIN
{
$prog="make_installer.pl";
+ # WARNING: the following lines are matched verbatim in i18npool/source/isolang/langid.pl
+
@noMSLocaleLangs = (
"br",
"bs",
@@ -153,8 +155,8 @@ BEGIN
$fontsfolder = "FontsFolder";
$fontsfoldername = "Fonts";
$fontsdirparent = "";
- $fontsdirname = "";
$fontsdirhostname = "truetype";
+ $fontsdirname = $fontsdirhostname;
$officefolder = "OfficeFolder";
$officemenufolder = "OfficeMenuFolder";
$startupfolder = "StartupFolder";
@@ -232,7 +234,7 @@ BEGIN
$creating_windows_installer_patch = 0;
$strip = 1;
-
+
$globallogging = 0;
$logfilename = "logfile.log"; # the default logfile name for global errors
# @logfileinfo = ();
@@ -411,8 +413,6 @@ BEGIN
$previous_idt_dir = "";
$updatepack = 0;
$msitranpath = "";
- $insert_file_at_end = 0;
- $newfilesexist = 0;
$usesharepointpath = 0;
%newfilescollector = ();
@@ -489,10 +489,6 @@ BEGIN
$isunix = 0;
$iswin = 1;
$archiveformat = ".zip";
- %savedmapping = ();
- %savedrevmapping = ();
- %savedrev83mapping = ();
- %saved83dirmapping = ();
}
elsif ( $plat =~ /os2/i )
{
@@ -539,6 +535,13 @@ BEGIN
# ToDo: Needs to be expanded for additional platforms
+ $is_release = 0; # Is changed in parameter.pm when the -release option is given.
+ $source_version = undef;
+ $target_version = undef;
+ $source_msi = undef;
+
+ # Is set to 1 when target_version is a major version, ie ?.0.0
+ $is_major_release = 0;
}
1;
Modified: openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/languages.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/languages.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/languages.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/languages.pm Wed Dec 11 08:49:16 2013
@@ -29,6 +29,10 @@ use installer::exiter;
use installer::globals;
use installer::remover;
use installer::ziplist;
+use Digest::MD5;
+
+use strict;
+
=head2 analyze_languagelist()
@@ -70,6 +74,33 @@ sub analyze_languagelist()
+=head2 get_language_directory_name ($language_string)
+
+ Create a directory name that contains the given set of languages.
+ When $language_string exceeds a certain length then it is shortened.
+
+=cut
+sub get_language_directory_name ($)
+{
+ my ($language_string) = @_;
+
+ if (length($language_string) > $installer::globals::max_lang_length)
+ {
+ my $number_of_languages = ($language_string =~ tr/_//);
+ my $digest = new Digest::MD5();
+ $digest->add($language_string);
+ my $short_digest = substr($digest->hexdigest(), 0, 8);
+ return "lang_" . $number_of_languages . "_id_" . $short_digest;
+ }
+ else
+ {
+ return $language_string;
+ }
+}
+
+
+
+
####################################################
# Reading languages from zip list file
####################################################
@@ -122,28 +153,24 @@ sub all_elements_of_array1_in_array2
#############################################
# All languages defined for one product
#############################################
-
-sub get_all_languages_for_one_product
+
+=head2 get_all_languages_for_one_product($languagestring, $allvariables)
+
+ $languagestring can be one or more language names, separated by ','.
+
+ $installer::globals::ismultilingual is set to 1 when $languagestring contains more than one languages.
+
+=cut
+sub get_all_languages_for_one_product ($$)
{
my ( $languagestring, $allvariables ) = @_;
- my @languagearray = ();
- my $last = $languagestring;
-
- $installer::globals::ismultilingual = 0; # setting the global variable $ismultilingual !
- if ( $languagestring =~ /\,/ ) { $installer::globals::ismultilingual = 1; }
-
- while ( $last =~ /^\s*(.+?)\,(.+)\s*$/) # "$" for minimal matching, comma separated list
- {
- my $first = $1;
- $last = $2;
- installer::remover::remove_leading_and_ending_whitespaces(\$first);
- push(@languagearray, "$first");
- }
+ $installer::globals::ismultilingual = ($languagestring =~ /\,/ ) ? 1 : 0;
- installer::remover::remove_leading_and_ending_whitespaces(\$last);
- push(@languagearray, "$last");
+ my $languages = $languagestring;
+ $languages =~ s/\s+//g;
+ my @languagearray = split(/,/, $languages);
if ( $installer::globals::iswindowsbuild )
{
@@ -381,10 +408,94 @@ sub get_java_language
# $javalanguage =~ s/\-/\_/;
# }
- $javalanguage = $language;
+ my $javalanguage = $language;
$javalanguage =~ s/\-/\_/;
return $javalanguage;
}
+
+
+=head2 get_key_language ($languages)
+
+ Determine the key language from the array of @$languages.
+
+ If there is only one language then that is the key language.
+
+ If there are two languages and one is en-US and was automatically
+ added, then the other language is the key language.
+
+ When there is more than one language and the case above does not
+ apply then return either 'multiasia' or 'multiwestern' as key
+ language, depending on whether one of the asian language parts
+ 'jp', 'ko', 'zh' appear.
+
+=cut
+sub get_key_language ($)
+{
+ my ($languages) = @_;
+
+ my $language_count = scalar @$languages;
+
+ if ($language_count == 1)
+ {
+ return $languages->[0];
+ }
+ else
+ {
+ if ($installer::globals::added_english && $language_count==1)
+ {
+ # Only multilingual because of added English.
+ return $languages->[1];
+ }
+ else
+ {
+ if ($languages->[1] =~ /(jp|ko|zh)/)
+ {
+ return "multiasia";
+ }
+ else
+ {
+ return "multiwestern";
+ }
+ }
+ }
+}
+
+
+
+
+=head2 get_normalized_language ($language)
+
+ Transform "..._<language>" into "<language>".
+ The ... part, if it exists, is typically en-US.
+
+ If $language does not contain a '_' then $language is returned unmodified.
+
+=cut
+sub get_normalized_language ($)
+{
+ my ($language) = @_;
+
+ if (ref($language) eq "ARRAY")
+ {
+ if (scalar @$language > 1 && $language->[0] eq "en-US")
+ {
+ return $language->[1];
+ }
+ else
+ {
+ return $language;
+ }
+ }
+ elsif ($language =~ /^.*?_(.*)$/)
+ {
+ return $1;
+ }
+ else
+ {
+ return $language;
+ }
+}
+
1;
Modified: openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/logger.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/logger.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/logger.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/logger.pm Wed Dec 11 08:49:16 2013
@@ -89,6 +89,44 @@ our $Info = installer::logger->new("info
'is_show_log_id' => 0
);
+
+
+=head2 SetupSimpleLogging ($filename)
+
+ Setup logging so that $Global, $Lang and $Info all print to the console.
+ If $filename is given then logging also goes to that file.
+
+=cut
+sub SetupSimpleLogging (;$)
+{
+ my ($log_filename) = @_;
+
+ $Info = installer::logger->new("info",
+ 'is_print_to_console' => 1,
+ 'is_show_relative_time' => 1,
+ );
+ $Global = installer::logger->new("glob",
+ 'is_print_to_console' => 0,
+ 'is_show_relative_time' => 1,
+ 'forward' => [$Info]
+ );
+ $Lang = installer::logger->new("lang",
+ 'is_print_to_console' => 0,
+ 'is_show_relative_time' => 1,
+ 'forward' => [$Info]
+ );
+ if (defined $log_filename)
+ {
+ $Info->set_filename($log_filename);
+ }
+ $Info->{'is_print_to_console'} = 1;
+ $installer::globals::quiet = 0;
+ starttime();
+}
+
+
+
+
=head2 new($class, $id, @arguments)
Create a new instance of the logger class.
@@ -119,7 +157,9 @@ sub new ($$@)
# Show log id (mostly for debugging the logger)
'is_show_log_id' => 0,
# Show the process id, useful on the console when doing a multiprocessor build.
- 'is_show_process_id' => 0
+ 'is_show_process_id' => 0,
+ # Current indentation
+ 'indentation' => "",
};
while (scalar @arguments >= 2)
{
@@ -219,6 +259,7 @@ sub process_line ($$$$$$)
{
$line .= $pid . " : ";
}
+ $line .= $self->{'indentation'};
$line .= $message;
# Print the line to a file or to the console or store it for later use.
@@ -359,6 +400,24 @@ sub set_forward ($$)
+sub increase_indentation ($)
+{
+ my ($self) = @_;
+ $self->{'indentation'} .= " ";
+}
+
+
+
+
+sub decrease_indentation ($)
+{
+ my ($self) = @_;
+ $self->{'indentation'} = substr($self->{'indentation'}, 4);
+}
+
+
+
+
####################################################
# Including header files into the logfile
####################################################
@@ -637,6 +696,9 @@ sub print_error
{
my $message = shift;
chomp $message;
+
+ PrintError($message);
+
print STDERR "\n";
print STDERR "**************************************************\n";
print STDERR "ERROR: $message";
@@ -646,6 +708,18 @@ sub print_error
}
+
+
+sub PrintError ($@)
+{
+ my ($format, @arguments) = @_;
+
+ $Info->printf("Error: ".$format, @arguments);
+}
+
+
+
+
=head2 PrintStackTrace()
This is for debugging the print and printf methods of the logger class and their use.
Therefore we use the Perl print/printf directly and not the logger methods to avoid loops in case of errors.
Modified: openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/packagepool.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/packagepool.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/packagepool.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/packagepool.pm Wed Dec 11 08:49:16 2013
@@ -163,16 +163,15 @@ sub compare_package_content
if ( $identical )
{
my $first = 1;
- my $start = "\n";
foreach my $dest ( keys %{$newcontent} )
{
if ( ! exists($oldcontent->{$dest}) )
{
$identical = 0;
- $installer::logger::Info->printf("%s...... file only in one package (A): %s\n", $start, $dest);
+ $installer::logger::Info->print("\n") if $first;
+ $installer::logger::Info->printf("...... file only in one package (A): %s\n", $dest);
$infoline = "File only in existing pool package: $dest\n";
push(@installer::globals::pcfdiffcomment, $infoline);
- if ( $first ) { $start = ""; }
$first = 0;
}
}
@@ -185,10 +184,10 @@ sub compare_package_content
if ( ! exists($newcontent->{$dest}) )
{
$identical = 0;
- $installer::logger::Info->printf("%s...... file only in one package (B): %s\n", $start, $dest);
+ $installer::logger::Info->print("\n") if $first;
+ $installer::logger::Info->printf("...... file only in one package (B): %s\n", $dest);
$infoline = "File only in new package: $dest\n";
push(@installer::globals::pcfdiffcomment, $infoline);
- if ( $first ) { $start = ""; }
$first = 0;
}
}
Modified: openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/parameter.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/parameter.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/parameter.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/parameter.pm Wed Dec 11 08:49:16 2013
@@ -164,6 +164,10 @@ sub getparameter
$path =~ s/^\Q$installer::globals::destdir\E//;
$installer::globals::rootpath = $path;
}
+ elsif ($param eq "-release")
+ {
+ $installer::globals::is_release = 1;
+ }
else
{
installer::logger::print_error( "unknown parameter: $param" );
@@ -171,7 +175,7 @@ sub getparameter
exit(-1);
}
}
-
+
# Usage of simple installer (not for Windows):
# $PERL -w $SOLARENV/bin/make_installer.pl \
# -f openoffice.lst -l en-US -p OpenOffice \
@@ -634,7 +638,6 @@ sub outputparameter ()
foreach my $line (@output)
{
$installer::logger::Info->print($line);
- $installer::logger::Global->print($line);
}
}
Modified: openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/FileSequenceList.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/FileSequenceList.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/FileSequenceList.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/FileSequenceList.pm Wed Dec 11 08:49:16 2013
@@ -1,159 +1,156 @@
-#**************************************************************
-#
-# 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::FileSequenceList;
-
-use XML::LibXML;
-use strict;
-
-=head1 NAME
-
- FileSequenceList.pm - Class for retrieving and processing the 'Sequence' values of the MSI 'File' table.
-
-=cut
-
-=head2 new($class)
-
- Create a new FileSequenceList object.
-
-=cut
-sub new ($)
-{
- my ($class) = @_;
-
- my $self = {
- 'data' => undef
- };
- bless($self, $class);
-
- return $self;
-}
-
-
-
-
-sub SetFromFileList ($$)
-{
- my ($self, $files) = @_;
-
- my %data = map {$_->{'uniquename'} => $_->{'sequencenumber'}} @$files;
- $self->{'data'} = \%data;
-}
-
-
-
-
-sub SetFromMap ($$)
-{
- my ($self, $map) = @_;
-
- $self->{'data'} = $map;
-}
-
-
-
-
-sub GetFileCount ($)
-{
- my ($self) = @_;
-
- return scalar keys %{$self->{'data'}};
-}
-
-
-
-
-=head2 GetSequenceNumbers ($files)
-
- $files is a hash that maps unique file names (File->File) to sequence
- numbers (File->Sequence). The later is (expected to be) initially unset and
- is set in this method.
-
- For new files -- entries in the given $files that do not exist in the 'data'
- member -- no sequence numbers are defined.
-
- When there are removed files -- entries in the 'data' member that do not
- exist in the given $files -- then a list of these files is returned. In
- that case the given $files remain unmodified.
-
- The returned list is empty when everyting is OK.
-
-=cut
-sub GetSequenceNumbers ($$)
-{
- my ($self, $files) = @_;
-
- # Check if files have been removed.
- my @missing = ();
- foreach my $name (keys %{$self->{'data'}})
- {
- if ( ! defined $files->{$name})
- {
- push @missing, $name;
- }
- }
- if (scalar @missing > 0)
- {
- # Yes. Return the names of the removed files.
- return @missing;
- }
-
- # No files where removed. Set the sequence numbers.
- foreach my $name (keys %$files)
- {
- $files->{$name} = $self->{'data'}->{$name};
- }
- return ();
-}
-
-
-
-
-sub GetDifference ($$)
-{
- my ($self, $other) = @_;
-
- # Create maps for easy reference.
- my (@files_in_both, @files_in_self, @files_in_other);
- foreach my $name (keys %{$self->{'data'}})
- {
- if (defined $other->{'data'}->{$name})
- {
- push @files_in_both, $name;
- }
- else
- {
- push @files_in_self, $name;
- }
- }
- foreach my $name (keys %{$self->{'data'}})
- {
- if ( ! defined $self->{'data'}->{$name})
- {
- push @files_in_other, $name;
- }
- }
-
- return (\@files_in_both, \@files_in_self, \@files_in_other);
-}
-
-
-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::FileSequenceList;
+
+use strict;
+
+=head1 NAME
+
+ FileSequenceList.pm - Class for retrieving and processing the 'Sequence' values of the MSI 'File' table.
+
+=cut
+
+=head2 new($class)
+
+ Create a new FileSequenceList object.
+
+=cut
+sub new ($)
+{
+ my ($class) = @_;
+
+ my $self = {
+ 'data' => undef
+ };
+ bless($self, $class);
+
+ return $self;
+}
+
+
+
+
+sub SetFromMap ($$)
+{
+ my ($self, $map) = @_;
+
+ $self->{'data'} = $map;
+}
+
+
+
+
+sub SetFromMsi ($$)
+{
+ my ($self, $msi) = @_;
+
+ my $file_table = $msi->GetTable("File");
+ my $file_map = $msi->GetFileMap();
+
+ my $file_column_index = $file_table->GetColumnIndex("File");
+ my $filename_column_index = $file_table->GetColumnIndex("FileName");
+ my $sequence_column_index = $file_table->GetColumnIndex("Sequence");
+
+ my %sequence_data = ();
+
+ printf("extracting columns %d and %d from %d rows\n",
+ $file_column_index,
+ $sequence_column_index,
+ $file_table->GetRowCount());
+
+ foreach my $row (@{$file_table->GetAllRows()})
+ {
+ my $unique_name = $row->GetValue($file_column_index);
+ my $filename = $row->GetValue($filename_column_index);
+ my ($long_filename,$short_filename) = installer::patch::Msi::SplitLongShortName($filename);
+ my $sequence = $row->GetValue($sequence_column_index);
+ my $directory_item = $file_map->{$unique_name}->{'directory'};
+ my $source_path = $directory_item->{'full_source_long_name'};
+ my $target_path = $directory_item->{'full_target_long_name'};
+ my $key = $source_path ne ""
+ ? $source_path."/".$long_filename
+ : $long_filename;
+ $sequence_data{$key} = {
+ 'sequence' => $sequence,
+ 'uniquename' => $unique_name,
+ 'row' => $row
+ };
+ }
+ $self->{'data'} = \%sequence_data;
+}
+
+
+
+
+sub GetFileCount ($)
+{
+ my ($self) = @_;
+
+ return scalar keys %{$self->{'data'}};
+}
+
+
+
+
+sub get_removed_files ($@)
+{
+ my ($self, $target_unique_names) = @_;
+
+ my %uniquename_to_row_map = map{$_->{'uniquename'} => $_->{'row'}} values %{$self->{'data'}};
+
+ # Check if files have been removed.
+ my @missing = ();
+ foreach my $item (values %{$self->{'data'}})
+ {
+ my ($uniquename, $row) = ($item->{'uniquename'}, $item->{'row'});
+ if ( ! defined $target_unique_names->{$uniquename})
+ {
+ # $name is defined in source but not in target => it has been removed.
+ push @missing, $row;
+ }
+ }
+ return @missing;
+}
+
+
+
+
+sub get_sequence_and_unique_name($$)
+{
+ my ($self, $source_path) = @_;
+
+ my $sequence_and_unique_name = $self->{'data'}->{$source_path};
+ if ( ! defined $sequence_and_unique_name)
+ {
+ $installer::logger::Lang->printf("can not find entry for source path '%s'\n", $source_path);
+ return (undef,undef);
+ }
+ else
+ {
+ return (
+ $sequence_and_unique_name->{'sequence'},
+ $sequence_and_unique_name->{'uniquename'});
+ }
+}
+
+
+1;
Modified: openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/InstallationSet.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/InstallationSet.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/InstallationSet.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/InstallationSet.pm Wed Dec 11 08:49:16 2013
@@ -1,467 +1,787 @@
-#**************************************************************
-#
-# 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::InstallationSet;
-
-use installer::patch::Tools;
-use installer::patch::Version;
-use installer::logger;
-
-
-my $Unpacker = "/c/Program\\ Files/7-Zip/7z.exe";
-
-=head1 NAME
-
- package installer::patch::InstallationSet - Functions for handling installation sets
-
-=head1 DESCRIPTION
-
- This package contains functions for unpacking the .exe files that
- are created by the NSIS installer creator and the .cab files in
- the installation sets.
-
-=cut
-
-sub UnpackExe ($$)
-{
- my ($filename, $destination_path) = @_;
-
- $installer::logger::Info->printf("unpacking installation set to '%s'\n", $destination_path);
-
- # Unpack to a temporary path and change its name to the destination path
- # only when the unpacking has completed successfully.
- my $temporary_destination_path = $destination_path . ".tmp";
- File::Path::make_path($temporary_destination_path);
-
- my $windows_filename = installer::patch::Tools::CygpathToWindows($filename);
- my $windows_destination_path = installer::patch::Tools::CygpathToWindows($temporary_destination_path);
- my $command = join(" ",
- $Unpacker,
- "x", "-o".$windows_destination_path,
- $windows_filename);
- my $result = qx($command);
-
- # Check the existence of the .cab files.
- my $cab_filename = File::Spec->catfile($temporary_destination_path, "openoffice1.cab");
- if ( ! -f $cab_filename)
- {
- installer::logger::PrintError("cab file '%s' was not extracted from installation set\n", $cab_filename);
- return 0;
- }
- if (rename($temporary_destination_path, $destination_path) == 0)
- {
- installer::logger::PrintError("can not rename temporary extraction directory\n");
- return 0;
- }
- return 1;
-}
-
-
-
-
-=head2 UnpackCab($cab_filename, $destination_path)
-
- Unpacking the cabinet file inside an .exe installation set is a
- three step process because there is no directory information stored
- inside the cab file. This has to be taken from the 'File' and
- 'Directory' tables in the .msi file.
-
- 1. Setup the directory structure of all files in the cab from the 'File' and 'Directory' tables in the msi.
-
- 2. Unpack the cab file.
-
- 3. Move the files to their destination directories.
-
-=cut
-sub UnpackCab ($$$)
-{
- my ($cab_filename, $msi, $destination_path) = @_;
-
- # Step 1
- # Extract the directory structure from the 'File' and 'Directory' tables in the given msi.
- $installer::logger::Info->printf("setting up directory tree\n");
- my $file_table = $msi->GetTable("File");
- my $file_to_directory_map = $msi->GetFileToDirectoryMap();
-
- # Step 2
- # Unpack the .cab file to a temporary path.
- my $temporary_destination_path = $destination_path . ".tmp";
- if ( -d $temporary_destination_path)
- {
- # Temporary directory already exists => cab file has already been unpacked (flat), nothing to do.
- $installer::logger::Info->printf("cab file has already been unpacked to flat structure\n");
- }
- else
- {
- UnpackCabFlat($cab_filename, $temporary_destination_path, $file_table);
- }
-
- # Step 3
- # Move the files to their destinations.
- File::Path::make_path($destination_path);
- $installer::logger::Info->printf("moving files to their directories\n");
- my $count = 0;
- foreach my $file_row (@{$file_table->GetAllRows()})
- {
- my $unique_name = $file_row->GetValue('File');
- my $directory_full_names = $file_to_directory_map->{$unique_name};
- my ($source_full_name, $target_full_name) = @$directory_full_names;
-
- my $flat_filename = File::Spec->catfile($temporary_destination_path, $unique_name);
- my $dir_path = File::Spec->catfile($destination_path, $source_full_name);
- my $dir_filename = File::Spec->catfile($dir_path, $unique_name);
-
- printf("%d: making path %s and copying %s to %s\n",
- $count,
- $dir_path,
- $unique_name,
- $dir_filename);
- File::Path::make_path($dir_path);
- File::Copy::move($flat_filename, $dir_filename);
-
- ++$count;
- }
-
- # Cleanup. Remove the temporary directory. It should be empty by now.
- rmdir($temporary_destination_path);
-}
-
-
-
-
-=head2 UnpackCabFlat ($cab_filename, $destination_path, $file_table)
-
- Unpack the flat file structure of the $cab_filename to $destination_path.
-
- In order to detect and handle an incomplete (arborted) previous
- extraction, the cab file is unpacked to a temprorary directory
- that after successful extraction is renamed to $destination_path.
-
-=cut
-sub UnpackCabFlat ($$$)
-{
- my ($cab_filename, $destination_path, $file_table) = @_;
-
- # Unpack the .cab file to a temporary path (note that
- # $destination_path may alreay bee a temporary path). Using a
- # second one prevents the lengthy flat unpacking to be repeated
- # when another step fails.
-
- $installer::logger::Info->printf("unpacking cab file\n");
- my $temporary_destination_path = $destination_path . ".tmp";
- File::Path::make_path($temporary_destination_path);
- my $windows_cab_filename = installer::patch::Tools::CygpathToWindows($cab_filename);
- my $windows_destination_path = installer::patch::Tools::CygpathToWindows($temporary_destination_path);
- my $command = join(" ",
- $Unpacker,
- "x", "-o".$windows_destination_path,
- $windows_cab_filename,
- "-y");
- printf("running command '%s'\n", $command);
- open my $cmd, $command."|";
- my $extraction_count = 0;
- my $file_count = $file_table->GetRowCount();
- while (<$cmd>)
- {
- my $message = $_;
- chomp($message);
- ++$extraction_count;
- printf("%4d/%4d %3.2f%% \r",
- $extraction_count,
- $file_count,
- $extraction_count*100/$file_count);
- }
- close $cmd;
- printf("extraction done \n");
-
- rename($temporary_destination_path, $destination_path)
- || installer::logger::PrintError(
- "can not rename the temporary directory '%s' to '%s'\n",
- $temporary_destination_path,
- $destination_path);
-}
-
-
-
-
-=head GetUnpackedMsiPath ($version, $language, $package_format, $product)
-
- Convenience function that returns where a downloadable installation set is extracted to.
-
-=cut
-sub GetUnpackedMsiPath ($$$$)
-{
- my ($version, $language, $package_format, $product) = @_;
-
- return File::Spec->catfile(
- GetUnpackedPath($version, $language, $package_format, $product),
- "unpacked_msi");
-}
-
-
-
-
-=head GetUnpackedCabPath ($version, $language, $package_format, $product)
-
- Convenience function that returns where a cab file is extracted
- (with injected directory structure from the msi file) to.
-
-=cut
-sub GetUnpackedCabPath ($$$$)
-{
- my ($version, $language, $package_format, $product) = @_;
-
- return File::Spec->catfile(
- GetUnpackedPath($version, $language, $package_format, $product),
- "unpacked_cab");
-}
-
-
-
-
-=head2 GetUnpackedPath($version, $language, $package_format, $product)
-
- Internal function for creating paths to where archives are unpacked.
-
-=cut
-sub GetUnpackedPath ($$$$)
-{
- my ($version, $language, $package_format, $product) = @_;
-
- return File::Spec->catfile(
- $ENV{'SRC_ROOT'},
- "instsetoo_native",
- $ENV{'INPATH'},
- $product,
- $package_format,
- installer::patch::Version::ArrayToDirectoryName(installer::patch::Version::StringToNumberArray($version)),
- $language);
-}
-
-
-
-
-=head2 Download($language, $release_data, $filename)
-
- Download an installation set to $filename. The URL for the
- download is taken from $release_data, a snippet from the
- instsetoo_native/data/releases.xml file.
-
-=cut
-sub Download ($$$)
-{
- my ($language, $release_data, $filename) = @_;
-
- my $url = $release_data->{'URL'};
- $release_data->{'URL'} =~ /^(.*)\/([^\/]+)$/;
- my ($location, $basename) = ($1,$2);
-
- $installer::logger::Info->printf("downloading %s\n", $basename);
- $installer::logger::Info->printf(" from '%s'\n", $location);
- my $filesize = $release_data->{'file-size'};
- $installer::logger::Info->printf(" expected size is %d\n", $filesize);
- my $temporary_filename = $filename . ".part";
- my $resume_size = 0;
- if ( -f $temporary_filename)
- {
- $resume_size = -s $temporary_filename;
- $installer::logger::Info->printf(" trying to resume at %d/%d bytes\n", $resume_size, $filesize);
- }
-
- # Prepare checksum.
- my $checksum = undef;
- my $checksum_type = $release_data->{'checksum-type'};
- my $checksum_value = $release_data->{'checksum-value'};
- my $digest = undef;
- if ($checksum_type eq "sha256")
- {
- $digest = Digest->new("SHA-256");
- }
- elsif ($checksum_type eq "md5")
- {
- $digest = Digest->new("md5");
- }
- else
- {
- installer::logger::PrintError(
- "checksum type %s is not supported. Supported checksum types are: sha256,md5\n",
- $checksum_type);
- return 0;
- }
-
- # Download the extension.
- open my $out, ">>$temporary_filename";
- binmode($out);
-
- my $mode = $|;
- my $handle = select STDOUT;
- $| = 1;
- select $handle;
-
- my $agent = LWP::UserAgent->new();
- $agent->timeout(120);
- $agent->show_progress(0);
- my $last_was_redirect = 0;
- my $bytes_read = 0;
- $agent->add_handler('response_redirect'
- => sub{
- $last_was_redirect = 1;
- return;
- });
- $agent->add_handler('response_data'
- => sub{
- if ($last_was_redirect)
- {
- $last_was_redirect = 0;
- # Throw away the data we got so far.
- $digest->reset();
- close $out;
- open $out, ">$temporary_filename";
- binmode($out);
- }
- my($response,$agent,$h,$data)=@_;
- print $out $data;
- $digest->add($data);
- $bytes_read += length($data);
- printf("read %*d / %d %d%% \r",
- length($filesize),
- $bytes_read,
- $filesize,
- $bytes_read*100/$filesize);
- });
- my $response;
- if ($resume_size > 0)
- {
- $response = $agent->get($url, 'Range' => "bytes=$resume_size-");
- }
- else
- {
- $response = $agent->get($url);
- }
- close $out;
-
- $handle = select STDOUT;
- $| = $mode;
- select $handle;
-
- $installer::logger::Info->print(" \r");
-
- if ($response->is_success())
- {
- if ($digest->hexdigest() eq $checksum_value)
- {
- $installer::logger::Info->PrintInfo("download was successfull\n");
- if ( ! rename($temporary_filename, $filename))
- {
- installer::logger::PrintError("can not rename '%s' to '%s'\n", $temporary_filename, $filename);
- return 0;
- }
- else
- {
- return 1;
- }
- }
- else
- {
- installer::logger::PrintError("%s checksum is wrong\n", $checksum_type);
- return 0;
- }
- }
- else
- {
- installer::logger::PrintError("there was a download error\n");
- return 0;
- }
-}
-
-
-
-
-=head2 ProvideDownloadSet ($version, $language, $package_format)
-
- Download an installation set when it is not yet present to
- $ENV{'TARFILE_LOCATION'}. Verify the downloaded file with the
- checksum that is extracted from the
- instsetoo_native/data/releases.xml file.
-
-=cut
-sub ProvideDownloadSet ($$$)
-{
- my ($version, $language, $package_format) = @_;
-
- my $release_item = installer::patch::ReleasesList::Instance()->{$version}->{$package_format}->{$language};
-
- # Get basename of installation set from URL.
- $release_item->{'URL'} =~ /^(.*)\/([^\/]+)$/;
- my ($location, $basename) = ($1,$2);
-
- # Is the installation set already present in ext_sources/ ?
- my $need_download = 0;
- my $ext_sources_filename = File::Spec->catfile(
- $ENV{'TARFILE_LOCATION'},
- $basename);
- if ( ! -f $ext_sources_filename)
- {
- $installer::logger::Info->printf("download set is not in ext_sources/ (%s)\n", $ext_sources_filename);
- $need_download = 1;
- }
- else
- {
- $installer::logger::Info->printf("download set exists at '%s'\n", $ext_sources_filename);
- if ($release_item->{'checksum-type'} eq 'sha256')
- {
- $installer::logger::Info->printf("checking SHA256 checksum\n");
- my $digest = Digest->new("SHA-256");
- open my $in, "<", $ext_sources_filename;
- $digest->addfile($in);
- close $in;
- if ($digest->hexdigest() ne $release_item->{'checksum-value'})
- {
- $installer::logger::Info->printf(" mismatch\n", $ext_sources_filename);
- $need_download = 1;
- }
- else
- {
- $installer::logger::Info->printf(" match\n");
- }
- }
- }
-
- if ($need_download)
- {
- if ( ! installer::patch::InstallationSet::Download(
- $language,
- $release_item,
- $ext_sources_filename))
- {
- return 0;
- }
- if ( ! -f $ext_sources_filename)
- {
- $installer::logger::Info->printf("download set could not be downloaded\n");
- return 0;
- }
- }
-
- return $ext_sources_filename;
-}
-
-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::InstallationSet;
+
+use installer::patch::Tools;
+use installer::patch::Version;
+use installer::logger;
+
+use strict;
+
+# TODO: Detect the location of 7z.exe
+my $Unpacker = "/c/Program\\ Files/7-Zip/7z.exe";
+
+
+
+# TODO: Is there a touch in a standard library?
+sub touch ($)
+{
+ my ($filename) = @_;
+
+ open my $out, ">", $filename;
+ close $out;
+}
+
+
+
+
+=head1 NAME
+
+ package installer::patch::InstallationSet - Functions for handling installation sets
+
+=head1 DESCRIPTION
+
+ This package contains functions for unpacking the .exe files that
+ are created by the NSIS installer creator and the .cab files in
+ the installation sets.
+
+=cut
+
+sub UnpackExe ($$)
+{
+ my ($filename, $destination_path) = @_;
+
+ $installer::logger::Info->printf("unpacking installation set to '%s'\n", $destination_path);
+
+ # Unpack to a temporary path and change its name to the destination path
+ # only when the unpacking has completed successfully.
+ File::Path::make_path($destination_path);
+
+ my $windows_filename = installer::patch::Tools::ToEscapedWindowsPath($filename);
+ my $windows_destination_path = installer::patch::Tools::ToEscapedWindowsPath($destination_path);
+ my $command = join(" ",
+ $Unpacker,
+ "x",
+ "-y",
+ "-o".$windows_destination_path,
+ $windows_filename);
+ my $result = qx($command);
+
+ # Check the existence of the .cab files.
+ my $cab_filename = File::Spec->catfile($destination_path, "openoffice1.cab");
+ if ( ! -f $cab_filename)
+ {
+ installer::logger::PrintError("cab file '%s' was not extracted from installation set\n", $cab_filename);
+ return 0;
+ }
+ return 1;
+}
+
+
+
+
+=head2 UnpackCab($cab_filename, $destination_path)
+
+ Unpacking the cabinet file inside an .exe installation set is a
+ three step process because there is no directory information stored
+ inside the cab file. This has to be taken from the 'File' and
+ 'Directory' tables in the .msi file.
+
+ 1. Setup the directory structure of all files in the cab from the 'File' and 'Directory' tables in the msi.
+
+ 2. Unpack the cab file.
+
+ 3. Move the files to their destination directories.
+
+=cut
+sub UnpackCab ($$$)
+{
+ my ($cab_filename, $msi, $destination_path) = @_;
+
+ # Step 1
+ # Extract the directory structure from the 'File' and 'Directory' tables in the given msi.
+ $installer::logger::Info->printf("setting up directory tree\n");
+ my $file_table = $msi->GetTable("File");
+ my $file_map = $msi->GetFileMap();
+
+ # Step 2
+ # Unpack the .cab file to a temporary path.
+ my $temporary_destination_path = $destination_path . ".tmp";
+ if ( -d $temporary_destination_path)
+ {
+ # Temporary directory already exists => cab file has already been unpacked (flat), nothing to do.
+ $installer::logger::Info->printf("cab file has already been unpacked to flat structure\n");
+ }
+ else
+ {
+ UnpackCabFlat($cab_filename, $temporary_destination_path, $file_table);
+ }
+
+ # Step 3
+ # Move the files to their destinations.
+ File::Path::make_path($destination_path);
+ $installer::logger::Info->printf("moving files to their directories\n");
+ my $count = 0;
+ foreach my $file_row (@{$file_table->GetAllRows()})
+ {
+ my $unique_name = $file_row->GetValue('File');
+ my $directory_item = $file_map->{$unique_name}->{'directory'};
+ my $source_full_name = $directory_item->{'full_source_long_name'};
+
+ my $flat_filename = File::Spec->catfile($temporary_destination_path, $unique_name);
+ my $dir_path = File::Spec->catfile($destination_path, $source_full_name);
+ my $dir_filename = File::Spec->catfile($dir_path, $unique_name);
+
+ if ( ! -d $dir_path)
+ {
+ File::Path::make_path($dir_path);
+ }
+ File::Copy::move($flat_filename, $dir_filename);
+
+ ++$count;
+ }
+
+ # Cleanup. Remove the temporary directory. It should be empty by now.
+ rmdir($temporary_destination_path);
+}
+
+
+
+
+=head2 UnpackCabFlat ($cab_filename, $destination_path, $file_table)
+
+ Unpack the flat file structure of the $cab_filename to $destination_path.
+
+ In order to detect and handle an incomplete (arborted) previous
+ extraction, the cab file is unpacked to a temprorary directory
+ that after successful extraction is renamed to $destination_path.
+
+=cut
+sub UnpackCabFlat ($$$)
+{
+ my ($cab_filename, $destination_path, $file_table) = @_;
+
+ # Unpack the .cab file to a temporary path (note that
+ # $destination_path may alreay bee a temporary path). Using a
+ # second one prevents the lengthy flat unpacking to be repeated
+ # when another step fails.
+
+ $installer::logger::Info->printf("unpacking cab file\n");
+ File::Path::make_path($destination_path);
+ my $windows_cab_filename = installer::patch::Tools::ToEscapedWindowsPath($cab_filename);
+ my $windows_destination_path = installer::patch::Tools::ToEscapedWindowsPath($destination_path);
+ my $command = join(" ",
+ $Unpacker,
+ "x", "-o".$windows_destination_path,
+ $windows_cab_filename,
+ "-y");
+ open my $cmd, $command."|";
+ my $extraction_count = 0;
+ my $file_count = $file_table->GetRowCount();
+ while (<$cmd>)
+ {
+ my $message = $_;
+ chomp($message);
+ ++$extraction_count;
+ printf("%4d/%4d %3.2f%% \r",
+ $extraction_count,
+ $file_count,
+ $extraction_count*100/$file_count);
+ }
+ close $cmd;
+}
+
+
+
+
+=head GetUnpackedExePath ($version, $is_current_version, $language, $package_format, $product)
+
+ Convenience function that returns where a downloadable installation set is extracted to.
+
+=cut
+sub GetUnpackedExePath ($$$$$)
+{
+ my ($version, $is_current_version, $language, $package_format, $product) = @_;
+
+ my $path = GetUnpackedPath($version, $is_current_version, $language, $package_format, $product);
+ return File::Spec->catfile($path, "unpacked");
+}
+
+
+
+
+=head GetUnpackedCabPath ($version, $is_current_version, $language, $package_format, $product)
+
+ Convenience function that returns where a cab file is extracted
+ (with injected directory structure from the msi file) to.
+
+=cut
+sub GetUnpackedCabPath ($$$$$)
+{
+ my ($version, $is_current_version, $language, $package_format, $product) = @_;
+
+ my $path = GetUnpackedPath($version, $is_current_version, $language, $package_format, $product);
+ return File::Spec->catfile($path, "unpacked");
+}
+
+
+
+
+=head2 GetUnpackedPath($version, $is_current_version, $language, $package_format, $product)
+
+ Internal function for creating paths to where archives are unpacked.
+
+=cut
+sub GetUnpackedPath ($$$$$)
+{
+ my ($version, $is_current_version, $language, $package_format, $product) = @_;
+
+ return File::Spec->catfile(
+ $ENV{'SRC_ROOT'},
+ "instsetoo_native",
+ $ENV{'INPATH'},
+ $product,
+ $package_format,
+ installer::patch::Version::ArrayToDirectoryName(
+ installer::patch::Version::StringToNumberArray($version)),
+ installer::languages::get_normalized_language($language));
+}
+
+
+
+
+sub GetMsiFilename ($$)
+{
+ my ($path, $version) = @_;
+
+ my $no_dot_version = installer::patch::Version::ArrayToNoDotName(
+ installer::patch::Version::StringToNumberArray(
+ $version));
+ return File::Spec->catfile(
+ $path,
+ "openoffice" . $no_dot_version . ".msi");
+}
+
+
+
+
+sub GetCabFilename ($$)
+{
+ my ($path, $version) = @_;
+
+ return File::Spec->catfile(
+ $path,
+ "openoffice1.cab");
+}
+
+
+
+
+=head2 Download($language, $release_data, $filename)
+
+ Download an installation set to $filename. The URL for the
+ download is taken from $release_data, a snippet from the
+ instsetoo_native/data/releases.xml file.
+
+=cut
+sub Download ($$$)
+{
+ my ($language, $release_data, $filename) = @_;
+
+ my $url = $release_data->{'URL'};
+ $release_data->{'URL'} =~ /^(.*)\/([^\/]+)$/;
+ my ($location, $basename) = ($1,$2);
+
+ $installer::logger::Info->printf("downloading %s\n", $basename);
+ $installer::logger::Info->printf(" from '%s'\n", $location);
+ my $filesize = $release_data->{'file-size'};
+ if (defined $filesize)
+ {
+ $installer::logger::Info->printf(" expected size is %d\n", $filesize);
+ }
+ else
+ {
+ $installer::logger::Info->printf(" file size is not yet known\n");
+ }
+ my $temporary_filename = $filename . ".part";
+ my $resume_size = 0;
+
+ # Prepare checksum.
+ my $checksum = undef;
+ my $checksum_type = $release_data->{'checksum-type'};
+ my $checksum_value = $release_data->{'checksum-value'};
+ my $digest = undef;
+ if ( ! defined $checksum_value)
+ {
+ # No checksum available. Skip test.
+ }
+ elsif ($checksum_type eq "sha256")
+ {
+ $digest = Digest->new("SHA-256");
+ }
+ elsif ($checksum_type eq "md5")
+ {
+ $digest = Digest->new("md5");
+ }
+ else
+ {
+ installer::logger::PrintError(
+ "checksum type %s is not supported. Supported checksum types are: sha256,md5\n",
+ $checksum_type);
+ return 0;
+ }
+
+ # Download the extension.
+ open my $out, ">$temporary_filename";
+ binmode($out);
+
+ my $mode = $|;
+ my $handle = select STDOUT;
+ $| = 1;
+ select $handle;
+
+ my $agent = LWP::UserAgent->new();
+ $agent->timeout(120);
+ $agent->show_progress(0);
+ my $last_was_redirect = 0;
+ my $bytes_read = 0;
+ $agent->add_handler('response_redirect'
+ => sub{
+ $last_was_redirect = 1;
+ return;
+ });
+ $agent->add_handler('response_data'
+ => sub{
+ if ($last_was_redirect)
+ {
+ $last_was_redirect = 0;
+ # Throw away the data we got so far.
+ $digest->reset() if defined $digest;
+ close $out;
+ open $out, ">$temporary_filename";
+ binmode($out);
+ }
+ my($response,$agent,$h,$data)=@_;
+ print $out $data;
+ $digest->add($data) if defined $digest;
+ $bytes_read += length($data);
+ if (defined $filesize)
+ {
+ printf("read %*d / %d %d%% \r",
+ length($filesize),
+ $bytes_read,
+ $filesize,
+ $bytes_read*100/$filesize);
+ }
+ else
+ {
+ printf("read %6.2f MB\r", $bytes_read/(1024.0*1024.0));
+ }
+ });
+ my $response;
+ if ($resume_size > 0)
+ {
+ $response = $agent->get($url, 'Range' => "bytes=$resume_size-");
+ }
+ else
+ {
+ $response = $agent->get($url);
+ }
+ close $out;
+
+ $handle = select STDOUT;
+ $| = $mode;
+ select $handle;
+
+ $installer::logger::Info->print(" \r");
+
+ if ($response->is_success())
+ {
+ if ( ! defined $digest
+ || $digest->hexdigest() eq $checksum_value)
+ {
+ $installer::logger::Info->print("download was successfull\n");
+ if ( ! rename($temporary_filename, $filename))
+ {
+ installer::logger::PrintError("can not rename '%s' to '%s'\n", $temporary_filename, $filename);
+ return 0;
+ }
+ else
+ {
+ return 1;
+ }
+ }
+ else
+ {
+ installer::logger::PrintError("%s checksum is wrong\n", $checksum_type);
+ return 0;
+ }
+ }
+ else
+ {
+ installer::logger::PrintError("there was a download error\n");
+ return 0;
+ }
+}
+
+
+
+
+=head2 ProvideDownloadSet ($version, $language, $package_format)
+
+ Download an installation set when it is not yet present to
+ $ENV{'TARFILE_LOCATION'}. Verify the downloaded file with the
+ checksum that is extracted from the
+ instsetoo_native/data/releases.xml file.
+
+=cut
+sub ProvideDownloadSet ($$$)
+{
+ my ($version, $language, $package_format) = @_;
+
+ my $release_item = installer::patch::ReleasesList::Instance()->{$version}->{$package_format}->{$language};
+
+ # Get basename of installation set from URL.
+ $release_item->{'URL'} =~ /^(.*)\/([^\/]+)$/;
+ my ($location, $basename) = ($1,$2);
+
+ # Is the installation set already present in ext_sources/ ?
+ my $need_download = 0;
+ my $ext_sources_filename = File::Spec->catfile(
+ $ENV{'TARFILE_LOCATION'},
+ $basename);
+ if ( ! -f $ext_sources_filename)
+ {
+ $installer::logger::Info->printf("download set is not in ext_sources/ (%s)\n", $ext_sources_filename);
+ $need_download = 1;
+ }
+ else
+ {
+ $installer::logger::Info->printf("download set exists at '%s'\n", $ext_sources_filename);
+ if (defined $release_item->{'checksum-value'}
+ && $release_item->{'checksum-type'} eq 'sha256')
+ {
+ $installer::logger::Info->printf("checking SHA256 checksum\n");
+ my $digest = Digest->new("SHA-256");
+ open my $in, "<", $ext_sources_filename;
+ $digest->addfile($in);
+ close $in;
+ if ($digest->hexdigest() ne $release_item->{'checksum-value'})
+ {
+ $installer::logger::Info->printf(" mismatch\n", $ext_sources_filename);
+ $need_download = 1;
+ }
+ else
+ {
+ $installer::logger::Info->printf(" match\n");
+ }
+ }
+ }
+
+ if ($need_download)
+ {
+ if ( ! installer::patch::InstallationSet::Download(
+ $language,
+ $release_item,
+ $ext_sources_filename))
+ {
+ return 0;
+ }
+ if ( ! -f $ext_sources_filename)
+ {
+ $installer::logger::Info->printf("download set could not be downloaded\n");
+ return 0;
+ }
+ }
+
+ return $ext_sources_filename;
+}
+
+
+
+
+sub ProvideUnpackedExe ($$$$$)
+{
+ my ($version, $is_current_version, $language, $package_format, $product_name) = @_;
+
+ # Check if the exe has already been unpacked.
+ my $unpacked_exe_path = installer::patch::InstallationSet::GetUnpackedExePath(
+ $version,
+ $is_current_version,
+ $language,
+ $package_format,
+ $product_name);
+ my $unpacked_exe_flag_filename = File::Spec->catfile($unpacked_exe_path, "__exe_is_unpacked");
+ my $exe_is_unpacked = -f $unpacked_exe_flag_filename;
+
+ if ($exe_is_unpacked)
+ {
+ # Yes, exe has already been unpacked. There is nothing more to do.
+ $installer::logger::Info->printf("downloadable installation set has already been unpacked to\n");
+ $installer::logger::Info->printf(" %s\n", $unpacked_exe_path);
+ return 1;
+ }
+ elsif ($is_current_version)
+ {
+ # For the current version the exe is created from the unpacked
+ # content and both are expected to be already present.
+
+ # In order to have the .cab and its unpacked content in one
+ # directory and don't interfere with the creation of regular
+ # installation sets, we copy the unpacked .exe into a separate
+ # directory.
+
+ my $original_path = File::Spec->catfile(
+ $ENV{'SRC_ROOT'},
+ "instsetoo_native",
+ $ENV{'INPATH'},
+ $product_name,
+ $package_format,
+ "install",
+ $language);
+ $installer::logger::Info->printf("creating a copy\n");
+ $installer::logger::Info->printf(" of %s\n", $original_path);
+ $installer::logger::Info->printf(" at %s\n", $unpacked_exe_path);
+ File::Path::make_path($unpacked_exe_path) unless -d $unpacked_exe_path;
+ my ($file_count,$directory_count) = CopyRecursive($original_path, $unpacked_exe_path);
+ return 0 if ( ! defined $file_count);
+ $installer::logger::Info->printf(" copied %d files in %d directories\n",
+ $file_count,
+ $directory_count);
+
+ touch($unpacked_exe_flag_filename);
+
+ return 1;
+ }
+ else
+ {
+ # No, we have to unpack the exe.
+
+ # Provide the exe.
+ my $filename = installer::patch::InstallationSet::ProvideDownloadSet(
+ $version,
+ $language,
+ $package_format);
+
+ # Unpack it.
+ if (defined $filename)
+ {
+ if (installer::patch::InstallationSet::UnpackExe($filename, $unpacked_exe_path))
+ {
+ $installer::logger::Info->printf("downloadable installation set has been unpacked to\n");
+ $installer::logger::Info->printf(" %s\n", $unpacked_exe_path);
+
+ touch($unpacked_exe_flag_filename);
+
+ return 1;
+ }
+ }
+ else
+ {
+ installer::logger::PrintError("could not provide .exe installation set at '%s'\n", $filename);
+ }
+ }
+
+ return 0;
+}
+
+
+
+
+sub CopyRecursive ($$)
+{
+ my ($source_path, $destination_path) = @_;
+
+ return (undef,undef) unless -d $source_path;
+
+ my @todo = ([$source_path, $destination_path]);
+ my $file_count = 0;
+ my $directory_count = 0;
+ while (scalar @todo > 0)
+ {
+ my ($source,$destination) = @{shift @todo};
+
+ next if ! -d $source;
+ File::Path::make_path($destination);
+ ++$directory_count;
+
+ # Read list of files in the current source directory.
+ opendir( my $dir, $source);
+ my @files = readdir $dir;
+ closedir $dir;
+
+ # Copy all files and push all directories to @todo.
+ foreach my $file (@files)
+ {
+ next if $file =~ /^\.+$/;
+
+ my $source_file = File::Spec->catfile($source, $file);
+ my $destination_file = File::Spec->catfile($destination, $file);
+ if ( -f $source_file)
+ {
+ File::Copy::copy($source_file, $destination_file);
+ ++$file_count;
+ }
+ elsif ( -d $source_file)
+ {
+ push @todo, [$source_file, $destination_file];
+ }
+ }
+ }
+
+ return ($file_count, $directory_count);
+}
+
+
+
+
+sub CheckLocalCopy ($$$$)
+{
+ my ($version, $language, $package_format, $product_name) = @_;
+
+ # Compare creation times of the original .msi and its copy.
+
+ my $original_path = File::Spec->catfile(
+ $ENV{'SRC_ROOT'},
+ "instsetoo_native",
+ $ENV{'INPATH'},
+ $product_name,
+ $package_format,
+ "install",
+ $language);
+
+ my $copy_path = installer::patch::InstallationSet::GetUnpackedExePath(
+ $version,
+ 1,
+ $language,
+ $package_format,
+ $product_name);
+
+ my $msi_basename = "openoffice"
+ . installer::patch::Version::ArrayToNoDotName(
+ installer::patch::Version::StringToNumberArray($version))
+ . ".msi";
+
+ my $original_msi_filename = File::Spec->catfile($original_path, $msi_basename);
+ my $copied_msi_filename = File::Spec->catfile($copy_path, $msi_basename);
+
+ my @original_msi_stats = stat($original_msi_filename);
+ my @copied_msi_stats = stat($copied_msi_filename);
+ my $original_msi_mtime = $original_msi_stats[9];
+ my $copied_msi_mtime = $copied_msi_stats[9];
+
+ if (defined $original_msi_mtime
+ && defined $copied_msi_mtime
+ && $original_msi_mtime > $copied_msi_mtime)
+ {
+ # The installation set is newer than its copy.
+ # Remove the copy.
+ $installer::logger::Info->printf(
+ "removing copy of installation set (version %s) because it is out of date\n",
+ $version);
+ File::Path::remove_tree($copy_path);
+ }
+}
+
+
+
+
+=head2 ProvideUnpackedCab
+
+ 1a. Make sure that a downloadable installation set is present.
+ 1b. or that a freshly built installation set (packed and unpacked is present)
+ 2. Unpack the downloadable installation set
+ 3. Unpack the .cab file.
+
+ The 'Provide' in the function name means that any step that has
+ already been made is not made again.
+
+=cut
+sub ProvideUnpackedCab ($$$$$)
+{
+ my ($version, $is_current_version, $language, $package_format, $product_name) = @_;
+
+ if ($is_current_version)
+ {
+ # For creating patches we maintain a copy of the unpacked .exe. Make sure that that is updated when
+ # a new installation set has been built.
+ CheckLocalCopy($version, $language, $package_format, $product_name);
+ }
+
+ # Check if the cab file has already been unpacked.
+ my $unpacked_cab_path = installer::patch::InstallationSet::GetUnpackedCabPath(
+ $version,
+ $is_current_version,
+ $language,
+ $package_format,
+ $product_name);
+ my $unpacked_cab_flag_filename = File::Spec->catfile($unpacked_cab_path, "__cab_is_unpacked");
+ my $cab_is_unpacked = -f $unpacked_cab_flag_filename;
+
+ if ($cab_is_unpacked)
+ {
+ # Yes. Cab was already unpacked. There is nothing more to do.
+ $installer::logger::Info->printf("cab has already been unpacked to\n");
+ $installer::logger::Info->printf(" %s\n", $unpacked_cab_path);
+
+ return 1;
+ }
+ else
+ {
+ # Make sure that the exe is unpacked and the cab file exists.
+ ProvideUnpackedExe($version, $is_current_version, $language, $package_format, $product_name);
+
+ # Unpack the cab file.
+ my $unpacked_exe_path = installer::patch::InstallationSet::GetUnpackedExePath(
+ $version,
+ $is_current_version,
+ $language,
+ $package_format,
+ $product_name);
+ my $msi = new installer::patch::Msi(
+ installer::patch::InstallationSet::GetMsiFilename($unpacked_exe_path, $version),
+ $version,
+ $is_current_version,
+ $language,
+ $product_name);
+
+ my $cab_filename = installer::patch::InstallationSet::GetCabFilename(
+ $unpacked_exe_path,
+ $version);
+ if ( ! -f $cab_filename)
+ {
+ # Cab file does not exist.
+ installer::logger::PrintError(
+ "could not find .cab file at '%s'. Extraction of .exe seems to have failed.\n",
+ $cab_filename);
+ return 0;
+ }
+
+ if (installer::patch::InstallationSet::UnpackCab(
+ $cab_filename,
+ $msi,
+ $unpacked_cab_path))
+ {
+ $installer::logger::Info->printf("unpacked cab file '%s'\n", $cab_filename);
+ $installer::logger::Info->printf(" to '%s'\n", $unpacked_cab_path);
+
+ touch($unpacked_cab_flag_filename);
+
+ return 1;
+ }
+ else
+ {
+ return 0;
+ }
+ }
+}
+1;
Modified: openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/Msi.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/Msi.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/Msi.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/Msi.pm Wed Dec 11 08:49:16 2013
@@ -1,342 +1,474 @@
-#**************************************************************
-#
-# 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);
+
+ 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;