123531: Added some new files (scripts and modules) for creating patches.

solenv/bin/modules/installer/patch/FileOperations.pm

+#**************************************************************
+#
+#  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::FileOperations;
+
+use File::Basename;
+use File::Copy;
+use IO::Compress::Bzip2;
+use IO::Uncompress::Bunzip2;
+
+my $CompressionMethod = "bzip2";
+
+
+=head1 NAME
+
+    package installer::patch::FileOperations - Class for collecting, checking and executing file operations.
+
+=cut
+
+
+sub new ($)
+{
+    my ($class) = (@_);
+
+    my $self = {
+        'operations' => []
+    };
+    bless($self, $class);
+
+    return $self;
+}
+
+
+
+
+sub AddCopyOperation ($$$)
+{
+    my ($self, $source_name, $target_name) = @_;
+
+    push
+        @{$self->{'operations'}},
+        [
+            'copy',
+            $source_name,
+            $target_name
+        ];
+}
+
+
+
+
+sub AddMakeDirectoryOperation ($$)
+{
+    my ($self, $path) = @_;
+
+    push
+        @{$self->{'operations'}},
+        [
+            'mkdir',
+            $path
+        ];
+}
+
+
+
+
+sub AddCompressOperation ($$)
+{
+    my ($self, $filename) = @_;
+
+    push
+        @{$self->{'operations'}},
+        [
+            'compress',
+            $filename
+        ];
+}
+
+
+
+
+sub AddUncompressOperation ($$$)
+{
+    my ($self, $source_name, $target_name) = @_;
+
+    push
+        @{$self->{'operations'}},
+        [
+            'uncompress',
+            $source_name,
+            $target_name
+        ];
+}
+
+
+
+
+sub Check ($)
+{
+    my ($self) = @_;
+
+    # Keep track of which directories or files would be created to check if
+    # operations that depend on these files will succeed.
+    my %files = ();
+    my %directories = ();
+
+    my @error_messages = ();
+    foreach my $operation (@{$self->{'operations'}})
+    {
+        my $command = $operation->[0];
+
+        if ($command eq "copy")
+        {
+            my ($source_name, $destination_name) = ($operation->[1], $operation->[2]);
+            if ( ! -f $source_name)
+            {
+                push @error_messages, sprintf("%s is not a regular file and can not be copied", $source_name);
+            }
+            my $destination_path = dirname($destination_name);
+            if ( ! -d $destination_path && ! defined $directories{$destination_path})
+            {
+                push @error_messages, sprintf("destination path %s does not exist", $destination_path);
+            }
+            if ( -f $destination_name)
+            {
+                # The destination file already exists. We have to overwrite it.
+                if ( ! -w $destination_name)
+                {
+                    push @error_messges, sprintf("destination file %s exists but can not be overwritten", $destination_name);
+                }
+            }
+            $files{$destination_name} = 1;
+        }
+        elsif ($command eq "mkdir")
+        {
+            my $path = $operation->[1];
+            if ( -d $path)
+            {
+                # Directory already exists.  That is OK, the mkdir command will be silently ignored.
+            }
+            else
+            {
+                $directories{$path} = 1;
+            }
+        }
+        elsif ($command eq "compress")
+        {
+            my $filename = $operation->[1];
+            if ( ! -f $filename && ! defined $files{$filename})
+            {
+                # File does not exist and will not be created by an earlier operation.
+                push @error_messages, sprintf("file %s does not exist and can not be compressed", $filename);
+            }
+        }
+        elsif ($command eq "uncompress")
+        {
+            my ($source_filename, $destination_filename) = ($operation->[1], $operation->[2]);
+            if ($CompressionMethod eq "bzip2")
+            {
+                $source_filename .= ".bz2";
+            }
+            if ( ! -f $source_filename && ! defined $files{$source_filename})
+            {
+                # File does not exist and will not be created by an earlier operation.
+                push @error_messages, sprintf("file %s does not exist and can not be decompressed", $source_filename);
+            }
+            if ( -f $destination_filename && ! -w $destination_filename)
+            {
+                # Destination file aleady exists but can not be replaced.
+                push @error_messages, sprintf("compress destination file %s exists but can not be replaced", $destination_filename);
+            }
+        }
+        else
+        {
+            push @error_messages, sprintf("unknown operation %s", $command);
+        }
+    }
+
+    return @error_messages;
+}
+
+
+
+
+sub CheckAndExecute ($)
+{
+    my ($self) = @_;
+
+    my @error_messages = $self->Check();
+    if (scalar @error_messages > 0)
+    {
+        $installer::logger::Lang->printf("can not execute all operations:\n");
+        for my $message (@error_messages)
+        {
+            $installer::logger::Lang->printf("ERROR: %s\n", $message);
+        }
+        return 0;
+    }
+    else
+    {
+        return $self->Execute();
+    }
+}
+
+
+
+
+sub Execute ($)
+{
+    my ($self) = @_;
+
+    foreach my $operation (@{$self->{'operations'}})
+    {
+        my $command = $operation->[0];
+
+        if ($command eq "copy")
+        {
+            my ($source_name, $destination_name) = ($operation->[1], $operation->[2]);
+            $installer::logger::Lang->printf("copy from %s\n    to %s\n", $source_name, $destination_name);
+            if ( ! $DryRun)
+            {
+                my $result = copy($source_name, $destination_name);
+                if ( ! $result)
+                {
+                    $installer::logger::Lang->printf("ERROR: copying from %s to %s failed",
+                        $source_name, $destination_name);
+                }
+            }
+        }
+        elsif ($command eq "mkdir")
+        {
+            my $path = $operation->[1];
+            if ( -d $path)
+            {
+                # Path exists already. Do nothing.
+            }
+            else
+            {
+                $installer::logger::Lang->printf("creating directory %s\n", $path);
+                if ( ! $DryRun)
+                {
+                    if (File::Path::make_path($path, {'mode' => 0775}) == 0)
+                    {
+                        $installer::logger::Lang->printf("could not create directory %s\n", $path);
+                    }
+                }
+            }
+        }
+        elsif ($command eq "compress")
+        {
+            my $filename = $operation->[1];
+            $installer::logger::Lang->printf("compressing %s\n", $filename);
+            if ( ! $DryRun)
+            {
+                my $result = 0;
+                if ($CompressionMethod eq "bzip2")
+                {
+                    $result = IO::Compress::Bzip2::bzip2($filename => $filename.".bz2");
+                }
+                if ($result == 0)
+                {
+                    $installer::logger::Lang->printf("ERROR: could not compress %s\n", $filename);
+                }
+                else
+                {
+                    unlink($filename);
+                }
+            }
+        }
+        elsif ($command eq "uncompress")
+        {
+            my ($source_name, $destination_name) = ($operation->[1], $operation->[2]);
+            if ($CompressionMethod eq "bzip2")
+            {
+                $source_name .= ".bz2";
+            }
+            $installer::logger::Lang->printf("uncompressing %s to %s\n", $source_name, $destination_name);
+
+            my $destination_base_name = basename($destination_name);
+
+            if ( ! $DryRun)
+            {
+                my $result = 0;
+                if ($CompressionMethod eq "bzip2")
+                {
+                    $result = IO::Uncompress::Bunzip2::bunzip2($source_name => $destination_name);
+                }
+                if ($result == 0)
+                {
+                    $installer::logger::Lang->printf("ERROR: failed to extract content of '%s' from '%s'\n",
+                        $destination_name, $source_name);
+                    return 0;
+                }
+            }
+        }
+
+        else
+        {
+            die "unknown operation $command\n";
+        }
+    }
+
+    return 1;
+}
+
+
+
+sub GetOperationCount ($)
+{
+    my ($self) = @_;
+    return scalar @{$self->{'operations'}};
+}
+
+
+1;

solenv/bin/modules/installer/patch/FileSequenceList.pm

+#**************************************************************
+#
+#  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;

solenv/bin/modules/installer/patch/MsiRow.pm

+#**************************************************************
+#
+#  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;

solenv/bin/modules/installer/patch/MsiTable.pm

+#**************************************************************
+#
+#  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;

solenv/bin/modules/installer/patch/ReleasesList.pm

+#**************************************************************
+#
+#  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;

solenv/bin/modules/installer/patch/Tools.pm

+#**************************************************************
+#
+#  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;

solenv/bin/modules/installer/patch/Version.pm

+#**************************************************************
+#
+#  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::Version;
+
+
+=head1 NAME
+
+    package installer::patch::Version - Functions for handling version numbers.
+
+=cut
+
+
+
+# We handle version numbers that consist of three parts: major, minor and micro version number.
+my $VersionPartCount = 3;
+
+
+
+=head 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.
+
+    Returns an array with three elements (major, minor, micro).
+=cut
+sub StringToNumberArray ($)
+{
+    my ($version_string) = @_;
+
+    my @version_parts = split(/\./, $version_string);
+    while (scalar @version_parts < $VersionPartCount)
+    {
+        push @version_parts, "0";
+    }
+    return @version_parts;
+}
+
+
+
+
+=head ArrayToDirectoryName (@)
+
+    Return a directory name (without any path) for the given array of version numbers.
+
+=cut
+sub ArrayToDirectoryName (@)
+{
+    return "v-".join("-", @_);
+}
+
+
+
+
+
+1;

solenv/bin/patch_make_releases_xml.pl

+#!/usr/bin/perl -w
+
+#**************************************************************
+#
+#  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.
+#
+#**************************************************************
+
+use LWP::UserAgent;
+
+use strict;
+
+=head1 NAME
+
+    patch_make_releases_xml.pl - Create a section for the instsetoo_native/data/releases.xml file.
+
+=head1 SYNOPSIS
+
+    patch_make_releases_xml.pl <version-number>
+
+        version-number is the version number (eg 4.0.1) for which to create the releases.xml file.
+
+=head1 DESCRIPTION
+
+    Will contact http://archive.apache.org/dist/openoffice/<version-number>/binaries/ and
+    a) determine the set of languages
+    b) collect sizes and sha256 check sums for all Windows installation sets.
+
+    The result is printed to the console.  It has to be added manually to releases.xml.
+
+=cut
+
+
+if (scalar @ARGV != 1)
+{
+    print STDERR "usage: $0 <version-number>\n";
+    die;
+}
+
+my $version = $ARGV[0];
+
+print <<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
+
+sub DownloadFile ($)
+{
+    my $url = shift;
+
+    my $agent = LWP::UserAgent->new();
+    $agent->timeout(120);
+    $agent->show_progress(0);
+
+    my $file_content = "";
+    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.
+        $file_content = "";
+            }
+            my($response,$agent,$h,$data)=@_;
+        $file_content .= $data;
+        });
+    $agent->get($url);
+
+    return $file_content;
+}
+
+
+
+
+sub GetResponse ($)
+{
+    my $url = shift;
+
+    my $agent = LWP::UserAgent->new();
+    $agent->timeout(120);
+    $agent->show_progress(0);
+
+    my $file_content = "";
+    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.
+        $file_content = "";
+            }
+            my($response,$agent,$h,$data)=@_;
+        $file_content .= $data;
+        });
+    return $agent->get($url, 'Range' => "bytes=0-0");
+}
+
+my @languages = ();
+my @lines = split(/\n/, DownloadFile("http://archive.apache.org/dist/openoffice/".$version."/binaries/"));
+foreach my $line (@lines)
+{
+    next unless $line =~ /folder.gif/;
+    if ($line =~ /a href=\"([^\"\/]+)\/\"/)
+    {
+    my $language = $1;
+    next if $language eq "SDK";
+    next if $language =~ /^[A-Z]/;
+    push @languages, $language;
+    }
+}
+
+print "<releases>\n";
+print "  <release>\n";
+printf "    <version>%s</version>\n", $version;
+print "    <download>\n";
+print "      <package-format>msi</package-format>\n";
+print "      <url-template>\n";
+printf "        http://archive.apache.org/dist/openoffice/%s/binaries/%%L/Apache_OpenOffice_%s_Win_x86_install_%%L.exe\n",$version, $version;
+print "      </url-template>\n";
+foreach my $language (sort @languages)
+{
+    print "      <item>\n";
+    printf "        <language>%s</language>\n", $language;
+    my $name = sprintf(
+    "Apache_OpenOffice_%s_Win_x86_install_%s.exe",
+    $version,
+    $language,
+    $version,
+    $language);
+
+    my $content = DownloadFile(
+    sprintf("http://archive.apache.org/dist/openoffice/%s/binaries/%s/%s.sha256", $version, $language, $name));
+    if ($content =~ /^([a-f0-9]+)/)
+    {
+    printf("        <checksum type=\"sha256\">%s</checksum>\n", $1);
+    }
+    my $response = GetResponse(
+    sprintf("http://archive.apache.org/dist/openoffice/%s/binaries/%s/%s", $version, $language, $name));
+    my $content_range = $response->{'_headers'}->{'content-range'};
+    if ($content_range =~ /bytes 0-0\/(\d+)/)
+    {
+    printf("        <size>%s</size>\n", $1);
+    }
+    print "      </item>\n";
+}
+
+print "    </download>\n";
+print "  </release>\n";
+print "</releases>\n";

solenv/bin/release_prepare.pl

+#!/usr/bin/perl -w
+
+#**************************************************************
+#
+#  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.
+#
+#**************************************************************
+
+use lib ("$ENV{SOLARENV}/bin/modules");
+use installer::patch::InstallationSet;
+use installer::patch::Msi;
+use installer::patch::ReleasesList;
+use installer::ziplist;
+use installer::logger;
+
+use Getopt::Long;
+use Pod::Usage;
+use Digest;
+
+use strict;
+
+=head1 NAME
+
+    release_prepare.pl - Several functions to prepare release builds
+
+=head1 SYNOPSIS
+
+    release_prepare.pl [options] <language1> <language2> ...
+
+    Options:
+        --lst-file <filename>
+             Path to the .lst file, eg ../util/openoffice.lst
+        --product-name <product-name>
+             The product name, eg Apache_OpenOffice
+        --output-path <path>
+             Path to the instsetoo_native platform output tree
+        --source-version <major>.<minor>.<micro>
+             Override version number of the source.  If not given it is computed from the target version.
+
+=head1 DESCRIPTION
+
+    Prepare a release build:
+
+        - Provide installation sets of the previous version.
+          If they are not in ext_sources/ then they are downloaded.
+
+        - Unpack the installation sets.
+
+=cut
+
+
+sub ProcessCommandline ()
+{
+    my $arguments = {
+        'lst-file' => undef,
+        'product-name' => undef,
+        'output-path' => undef,
+        'source-version' => undef};
+
+    if ( ! GetOptions(
+               "lst-file=s", \$arguments->{'lst-file'},
+               "product-name=s", \$arguments->{'product-name'},
+               "output-path=s", \$arguments->{'output-path'},
+               "source-version:s" => \$arguments->{'source-version'}
+        ))
+    {
+        pod2usage(1);
+    }
+
+    if ( ! defined $arguments->{'lst-file'})
+    {
+        print STDERR "lst-file missing, please provide --lst-file\n";
+        pod2usage(2);
+    }
+    if ( ! defined $arguments->{'product-name'})
+    {
+        print STDERR "product name missing, please provide --product-name\n";
+        pod2usage(2);
+    }
+    if ( ! defined $arguments->{'output-path'})
+    {
+        print STDERR "output path missing, please provide --output-path\n";
+        pod2usage(2);
+    }
+
+    $arguments->{'languages'} = \@ARGV;
+
+    return $arguments;
+}
+
+
+
+
+sub ProcessLanguage ($$$$)
+{
+    my ($source_version, $language, $package_format, $product_name) = @_;
+
+    $installer::logger::Info->printf("%s\n", $language);
+    $installer::logger::Info->increase_indentation();
+
+    # For every language we need
+    # 1. have downloadable installation set available (download if missing)
+    # 2. unpack it to get access to .cab and .msi
+    # 3. unpack .cab so that msimsp.exe can be run
+
+    # Create paths to unpacked contents of .exe and .cab and determine if they exist.
+    # The existence of these paths is taken as flag whether the unpacking has already taken place.
+    my $unpacked_exe_path = installer::patch::InstallationSet::GetUnpackedMsiPath(
+        $source_version,
+        $language,
+        $package_format,
+        $product_name);
+    my $unpacked_cab_path = installer::patch::InstallationSet::GetUnpackedCabPath(
+        $source_version,
+        $language,
+        $package_format,
+        $product_name);
+    my $exe_is_unpacked = -d $unpacked_exe_path;
+    my $cab_is_unpacked = -d $unpacked_cab_path;
+
+    if ( ! $exe_is_unpacked)
+    {
+        # Interpret existence of path as proof that the installation
+        # set and the cab file have been successfully unpacked.
+        # Nothing to do.
+        my $filename = installer::patch::InstallationSet::ProvideDownloadSet(
+            $source_version,
+            $language,
+            $package_format);
+        if (defined $filename)
+        {
+            if ( ! -d $unpacked_exe_path)
+            {
+                installer::patch::InstallationSet::UnpackExe($filename, $unpacked_exe_path);
+            }
+        }
+        else
+        {
+            installer::logger::PrintError("could not provide .exe installation set at '%s'\n", $filename);
+        }
+    }
+    else
+    {
+        $installer::logger::Info->printf("downloadable installation set has already been unpacked to '%s'\n",
+            $unpacked_exe_path);
+    }
+
+    if ( ! $cab_is_unpacked)
+    {
+        my $cab_filename = File::Spec->catfile($unpacked_exe_path, "openoffice1.cab");
+        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);
+        }
+
+        # Unpack the cab file.
+        my $msi = new installer::patch::Msi(
+            $source_version,
+            $language,
+            $product_name);
+
+        $installer::logger::Info->printf("unpacking cab file '%s' to '%s'\n",
+            $cab_filename, $unpacked_cab_path);
+        installer::patch::InstallationSet::UnpackCab(
+            $cab_filename,
+            $msi,
+            $unpacked_cab_path);
+    }
+    else
+    {
+        $installer::logger::Info->printf("cab has already been unpacked to\n");
+        $installer::logger::Info->printf("    %s\n", $unpacked_cab_path);
+    }
+
+    $installer::logger::Info->decrease_indentation();
+}
+
+
+
+
+installer::logger::SetupSimpleLogging("c:/tmp/log");
+
+my $arguments = ProcessCommandline();
+$arguments->{'package-format'} = 'msi';
+
+print "preparing release build\n";
+my ($variables, undef, undef)
+    = installer::ziplist::read_openoffice_lst_file(
+        $arguments->{'lst-file'},
+        $arguments->{'product-name'},
+        undef);
+if ( ! defined $arguments->{'source-version'})
+{
+    $arguments->{'source-version'} = $variables->{'PREVIOUS_VERSION'};
+}
+$installer::logger::Info->printf("    reading data from '%s'\n", $arguments->{'lst-file'});
+$installer::logger::Info->printf("    product name is '%s'\n", $arguments->{'product-name'});
+$installer::logger::Info->printf("    output path is '%s'\n", $arguments->{'output-path'});
+$installer::logger::Info->printf("    source version is '%s'\n", $arguments->{'source-version'});
+
+foreach my $language (@{$arguments->{'languages'}})
+{
+    ProcessLanguage(
+        $arguments->{'source-version'},
+        $language,
+        $arguments->{'package-format'},
+        $arguments->{'product-name'});
+}