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 [6/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/patch/MsiRow.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/MsiRow.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/MsiRow.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/MsiRow.pm Wed Dec 11 08:49:16 2013
@@ -1,160 +1,169 @@
-#**************************************************************
-#
-# Licensed to the Apache Software Foundation (ASF) under one
-# or more contributor license agreements. See the NOTICE file
-# distributed with this work for additional information
-# regarding copyright ownership. The ASF licenses this file
-# to you under the Apache License, Version 2.0 (the
-# "License"); you may not use this file except in compliance
-# with the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing,
-# software distributed under the License is distributed on an
-# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
-# KIND, either express or implied. See the License for the
-# specific language governing permissions and limitations
-# under the License.
-#
-#**************************************************************
-
-package installer::patch::MsiRow;
-
-=head1 NAME
-
- package installer::patch::MsiRow - Class that represents a single row of an Msi table.
-
-=cut
-
-
-=head2 new ($class, $table, @data)
-
- Create a new MsiRow object for the given table row data. Each row
- stores a reference to its $table so that it can access global
- values like column names.
-
-=cut
-sub new ($$@)
-{
- my ($class, $table, @data) = @_;
-
- my $self = {
- 'table' => $table,
- 'values' => [@data]
- };
- bless($self, $class);
-
- my $column_count = $table->GetColumnCount();
- while (scalar @{$self->{'values'}} < $column_count)
- {
- push @{$self->{'values'}}, "";
- }
-
- return $self;
-}
-
-
-
-=head2 GetValue($self, $column)
-
- Return the value in the column specified by $column, which can be
- either the column name or the index of the column.
-
-=cut
-sub GetValue ($$)
-{
- my ($self, $column) = @_;
-
- if ($column =~ /^\d+$/)
- {
- return $self->{'values'}->[$column];
- }
- else
- {
- my $column_index = $self->{'table'}->GetColumnIndex($column);
- return $self->{'values'}->[$column_index];
- }
-}
-
-
-
-
-sub SetValue ($$$)
-{
- my ($self, $column, $value) = @_;
-
- if ($column =~ /^\d+$/)
- {
- $self->{'values'}->[$column] = $value;
- }
- else
- {
- my $column_index = $self->{'table'}->GetColumnIndex($column);
- $self->{'values'}->[$column_index] = $value;
- }
- $self->{'table'}->MarkAsModified();
-}
-
-
-
-
-sub Format ($$)
-{
- my $self = shift;
- my $concatenation = shift;
-
- my $result = "";
- my $first = 1;
- my $index = 0;
- my $column_count = $self->{'table'}->GetColumnCount();
- foreach my $item (@{$self->{'values'}})
- {
- ++$index;
-
- if ( ! $first)
- {
- $result .= $concatenation;
- }
- else
- {
- $first = 0;
- }
- $result .= $item;
- }
- return $result;
-}
-
-
-
-
-sub Clone ($$)
-{
- my ($self, $new_table) = @_;
-
- my $clone = { %$self };
- $clone->{'values'} = [ @{$self->{'values'}} ];
- $clone->{'table'} = $new_table;
- bless($clone, "MsiRow");
-
- return $clone;
-}
-
-
-
-
-sub SetTable ($$)
-{
- my ($self, $new_table) = @_;
-
- if (defined $self->{'table'} && $self->{'table'} != $new_table)
- {
- MsiTools::Die("can not reset table of row");
- }
- else
- {
- $self->{'table'} = $new_table;
- }
-}
-
-1;
+#**************************************************************
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+#**************************************************************
+
+package installer::patch::MsiRow;
+
+=head1 NAME
+
+ package installer::patch::MsiRow - Class that represents a single row of an Msi table.
+
+=cut
+
+
+=head2 new ($class, $table, @data)
+
+ Create a new MsiRow object for the given table row data. Each row
+ stores a reference to its $table so that it can access global
+ values like column names.
+
+=cut
+sub new ($$@)
+{
+ my ($class, $table, @data) = @_;
+
+ my $self = {
+ 'table' => $table,
+ 'values' => [@data]
+ };
+ bless($self, $class);
+
+ my $column_count = $table->GetColumnCount();
+ while (scalar @{$self->{'values'}} < $column_count)
+ {
+ push @{$self->{'values'}}, "";
+ }
+
+ return $self;
+}
+
+
+
+=head2 GetValue($self, $column)
+
+ Return the value in the column specified by $column, which can be
+ either the column name or the index of the column.
+
+=cut
+sub GetValue ($$)
+{
+ my ($self, $column) = @_;
+
+ if ($column =~ /^\d+$/)
+ {
+ return $self->{'values'}->[$column];
+ }
+ else
+ {
+ my $column_index = $self->{'table'}->GetColumnIndex($column);
+ return $self->{'values'}->[$column_index];
+ }
+}
+
+
+
+
+sub SetValue ($$$)
+{
+ my ($self, $column, $value) = @_;
+
+ if ($column =~ /^\d+$/)
+ {
+ $self->{'values'}->[$column] = $value;
+ }
+ else
+ {
+ my $column_index = $self->{'table'}->GetColumnIndex($column);
+ $self->{'values'}->[$column_index] = $value;
+ }
+ $self->{'table'}->MarkAsModified();
+}
+
+
+
+
+sub GetAllValues ($)
+{
+ my ($self) = @_;
+ return @{$self->{'values'}};
+}
+
+
+
+
+sub Format ($$)
+{
+ my $self = shift;
+ my $concatenation = shift;
+
+ my $result = "";
+ my $first = 1;
+ my $index = 0;
+ my $column_count = $self->{'table'}->GetColumnCount();
+ foreach my $item (@{$self->{'values'}})
+ {
+ ++$index;
+
+ if ( ! $first)
+ {
+ $result .= $concatenation;
+ }
+ else
+ {
+ $first = 0;
+ }
+ $result .= $item;
+ }
+ return $result;
+}
+
+
+
+
+sub Clone ($$)
+{
+ my ($self, $new_table) = @_;
+
+ my $clone = { %$self };
+ $clone->{'values'} = [ @{$self->{'values'}} ];
+ $clone->{'table'} = $new_table;
+ bless($clone, "MsiRow");
+
+ return $clone;
+}
+
+
+
+
+sub SetTable ($$)
+{
+ my ($self, $new_table) = @_;
+
+ if (defined $self->{'table'} && $self->{'table'} != $new_table)
+ {
+ MsiTools::Die("can not reset table of row");
+ }
+ else
+ {
+ $self->{'table'} = $new_table;
+ }
+}
+
+1;
Modified: openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/MsiTable.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/MsiTable.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/MsiTable.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/MsiTable.pm Wed Dec 11 08:49:16 2013
@@ -1,274 +1,492 @@
-#**************************************************************
-#
-# Licensed to the Apache Software Foundation (ASF) under one
-# or more contributor license agreements. See the NOTICE file
-# distributed with this work for additional information
-# regarding copyright ownership. The ASF licenses this file
-# to you under the Apache License, Version 2.0 (the
-# "License"); you may not use this file except in compliance
-# with the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing,
-# software distributed under the License is distributed on an
-# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
-# KIND, either express or implied. See the License for the
-# specific language governing permissions and limitations
-# under the License.
-#
-#**************************************************************
-
-package installer::patch::MsiTable;
-
-=head1 NAME
-
- package installer::patch::MsiTable - Class that represents one table of an Msi file.
-
-=cut
-
-use installer::patch::MsiRow;
-
-use strict;
-
-=head new ($class, $filename, $table_name)
-
- Create a new MsiTable object from the output of a previous
- msidb.exe run. The table is named $table_name, its data is read
- from $filename.
-
-=cut
-sub new ($$$)
-{
- my ($class, $filename, $table_name) = @_;
-
- my $self = {
- 'name' => $table_name,
- 'is_valid' => 1
- };
- bless($self, $class);
-
- if ( -f $filename)
- {
- $self->ReadFile($filename);
- }
- return $self;
-}
-
-
-
-
-sub IsValid ($)
-{
- my ($self) = @_;
- return $self->{'is_valid'};
-}
-
-
-
-
-sub Trim ($)
-{
- my $line = shift;
-
- $line =~ s/(^\s+|\s+$)//g;
-
- return $line;
-}
-
-
-
-=head2 ReadFile($self, $filename)
-
- Read the content of the table from the specified .idt file.
- For each row a MsiRow object is appended to $self->{'rows'}.
-
-=cut
-sub ReadFile ($$)
-{
- my ($self, $filename) = @_;
-
- if ( ! (-f $filename && -r $filename))
- {
- printf STDERR ("can not open idt file %s for reading\n", $filename);
- $self->{'is_valid'} = 0;
- return;
- }
-
- open my $in, "<", $filename;
-
- my $columns = Trim(<$in>);
- $self->{'columns'} = [split(/\t/, $columns)];
-
- my $column_specs = Trim(<$in>);
- $self->{'column_specs'} = [split(/\t/, $column_specs)];
-
- # Table name, index columns.
- my $line = Trim(<$in>);
- my @items = split(/\t/, $line);
- if (scalar @items == 3)
- {
- $self->{'codepage'} = shift @items;
- }
- my $table_name = shift @items;
- if ($table_name ne $self->{'name'})
- {
- printf STDERR ("reading wrong table data for table '%s' (got %s)\n", $self->{'name'}, $table_name);
- $self->{'is_valid'} = 0;
- return;
- }
- $self->{'index_columns'} = [@items];
- $self->{'index_column_index'} = $self->GetColumnIndex($items[0]);
-
- my $rows = [];
- while (<$in>)
- {
- # Remove all trailing returns and newlines. Keep trailing spaces and tabs.
- s/[\r\n]+$//g;
-
- my @items = split(/\t/, $_);
- push @$rows, new installer::patch::MsiRow($self, @items);
- }
- $self->{'rows'} = $rows;
-
- return $self;
-}
-
-
-
-=head2 GetColumnCount($self)
-
- Return the number of columns in the table.
-
-=cut
-sub GetColumnCount ($)
-{
- my ($self) = @_;
-
- return scalar @{$self->{'columns'}};
-}
-
-
-
-
-=head2 GetRowCount($self)
-
- Return the number of rows in the table.
-
-=cut
-sub GetRowCount ($)
-{
- my ($self) = @_;
-
- return scalar @{$self->{'rows'}};
-}
-
-
-
-
-=head2 GetColumnIndx($self, $column_name)
-
- Return the 0 based index of the column named $column_name. Use
- this to speed up (slightly) access to column values when accessing
- many or all rows of a table.
-
-=cut
-sub GetColumnIndex ($$)
-{
- my ($self, $column_name) = @_;
-
- my $index = 0;
- foreach my $name (@{$self->{'columns'}})
- {
- if ($name eq $column_name)
- {
- return $index;
- }
- ++$index;
- }
-
- printf STDERR ("did not find column %s in %s\n", $column_name, join(" and ", @{$self->{'columns'}}));
- return -1;
-}
-
-
-
-
-=head2 GetValue($self, $selector_column, $selector_column_value, $value_column)
-
- Find the row in which the $selector_column has value
- $selector_column_value and return its value in the $value_column.
-
-=cut
-
-sub GetValue ($$$$)
-{
- my ($self, $selector_column, $selector_column_value, $value_column) = @_;
-
- my $row = $self->GetRow($selector_column, $selector_column_value);
- if (defined $row)
- {
- return $row->GetValue($value_column);
- }
- else
- {
- return undef;
- }
-}
-
-
-
-
-=head2 GetRow($self, $column, $value)
-
- Return the (first) row which has $value in $column.
-
-=cut
-sub GetRow ($$$)
-{
- my ($self, $column, $value) = @_;
-
- my $column_index = $self->GetColumnIndex($column);
- if ($column_index<0)
- {
- printf STDERR "ERROR: unknown column $column in table $self->{'name'}\n";
- return undef;
- }
-
- foreach my $row (@{$self->{'rows'}})
- {
- if ($row->GetValue($column_index) eq $value)
- {
- return $row;
- }
- }
-
- printf STDERR ("ERROR: did not find row for %s->%s in %s\n",
- $column,
- $value,
- table $self->{'name'});
-
- return undef;
-}
-
-
-
-
-=head2 GetAllRows ($self)
-
- Return the reference to an array that contains all rows of the table.
-
-=cut
-
-sub GetAllRows ($)
-{
- my $self = shift;
-
- return $self->{'rows'};
-}
-
-
-
-
-
-1;
+#**************************************************************
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+#**************************************************************
+
+package installer::patch::MsiTable;
+
+=head1 NAME
+
+ package installer::patch::MsiTable - Class that represents one table of an Msi file.
+
+=cut
+
+use installer::patch::MsiRow;
+
+use strict;
+
+=head new ($class, $filename, $table_name)
+
+ Create a new MsiTable object from the output of a previous
+ msidb.exe run. The table is named $table_name, its data is read
+ from $filename.
+
+=cut
+sub new ($$$)
+{
+ my ($class, $filename, $table_name) = @_;
+
+ my $self = {
+ 'name' => $table_name,
+ 'filename' => $filename,
+ 'columns' => undef,
+ 'column_specs' => undef,
+ 'codepage' => undef,
+ 'is_valid' => 1,
+ 'is_modified' => 0
+ };
+ bless($self, $class);
+
+ if (defined $filename && -f $filename)
+ {
+ $self->ReadFile($filename);
+ }
+ return $self;
+}
+
+
+
+
+sub SetColumnData ($@)
+{
+ my ($self, @data) = @_;
+
+ if (((scalar @data) % 2) != 0)
+ {
+ installer::logger::PrintError("column data has to have an even number of elements: (<column-name> <data-spec>)+)\n");
+ $self->{'is_valid'} = 0;
+ return;
+ }
+
+ $self->{'columns'} = [];
+ $self->{'column_specs'} = [];
+ while (scalar @data > 0)
+ {
+ my $name = shift @data;
+ my $spec = shift @data;
+ push @{$self->{'columns'}}, $name;
+ push @{$self->{'column_specs'}}, $spec;
+ }
+}
+
+
+
+
+sub SetIndexColumns ($@)
+{
+ my ($self, @index_columns) = @_;
+
+ $self->{'index_columns'} = [@index_columns];
+}
+
+
+
+
+sub SetCodepage ($$)
+{
+ my ($self, $codepage) = @_;
+
+ $self->{'codepage'} = $codepage;
+}
+
+
+
+
+sub IsValid ($)
+{
+ my ($self) = @_;
+ return $self->{'is_valid'};
+}
+
+
+
+
+sub Trim ($)
+{
+ my $line = shift;
+
+ $line =~ s/(^\s+|\s+$)//g;
+
+ return $line;
+}
+
+
+
+=head2 ReadFile($self, $filename)
+
+ Read the content of the table from the specified .idt file.
+ For each row a MsiRow object is appended to $self->{'rows'}.
+
+=cut
+sub ReadFile ($$)
+{
+ my ($self, $filename) = @_;
+
+ if ( ! (-f $filename && -r $filename))
+ {
+ printf STDERR ("can not open idt file %s for reading\n", $filename);
+ $self->{'is_valid'} = 0;
+ return;
+ }
+
+ open my $in, "<", $filename;
+
+ my $columns = Trim(<$in>);
+ $self->{'columns'} = [split(/\t/, $columns)];
+
+ my $column_specs = Trim(<$in>);
+ $self->{'column_specs'} = [split(/\t/, $column_specs)];
+
+ # Table name, index columns.
+ my $line = Trim(<$in>);
+ my @items = split(/\t/, $line);
+ my $item_count = scalar @items;
+ if ($item_count>=1 && $items[0] eq $self->{'name'})
+ {
+ # No codepage.
+ }
+ elsif ($item_count>=2 && $items[1] eq $self->{'name'})
+ {
+ $self->{'codepage'} = shift @items;
+ }
+ else
+ {
+ printf STDERR ("reading wrong table data for table '%s' (got %s)\n", $self->{'name'}, $items[0]);
+ $self->{'is_valid'} = 0;
+ return;
+ }
+ shift @items;
+ $self->{'index_columns'} = [@items];
+ $self->{'index_column_index'} = $self->GetColumnIndex($items[0]);
+
+ my $rows = [];
+ while (<$in>)
+ {
+ # Remove all trailing returns and newlines. Keep trailing spaces and tabs.
+ s/[\r\n]+$//g;
+
+ my @items = split(/\t/, $_);
+ push @$rows, new installer::patch::MsiRow($self, @items);
+ }
+ $self->{'rows'} = $rows;
+
+ return $self;
+}
+
+
+
+
+=head WriteFile($self, $filename)
+
+ Write a text file containing the current table content.
+
+=cut
+sub WriteFile ($$)
+{
+ my ($self, $filename) = @_;
+
+ open my $out, ">".$self->{'filename'};
+
+ print $out join("\t", @{$self->{'columns'}})."\r\n";
+ print $out join("\t", @{$self->{'column_specs'}})."\r\n";
+ if (defined $self->{'codepage'})
+ {
+ print $out $self->{'codepage'} . "\t";
+ }
+ print $out $self->{'name'} . "\t";
+ print $out join("\t",@{$self->{'index_columns'}})."\r\n";
+
+ foreach my $row (@{$self->{'rows'}})
+ {
+ print $out $row->Format("\t")."\r\n";
+ }
+
+ close $out;
+}
+
+
+
+
+sub UpdateTimestamp ($)
+{
+ my $self = shift;
+
+ utime(undef,undef, $self->{'filename'});
+}
+
+
+
+
+sub GetName ($)
+{
+ my $self = shift;
+
+ return $self->{'name'};
+}
+
+
+
+
+=head2 GetColumnCount($self)
+
+ Return the number of columns in the table.
+
+=cut
+sub GetColumnCount ($)
+{
+ my ($self) = @_;
+
+ return scalar @{$self->{'columns'}};
+}
+
+
+
+
+=head2 GetRowCount($self)
+
+ Return the number of rows in the table.
+
+=cut
+sub GetRowCount ($)
+{
+ my ($self) = @_;
+
+ return scalar @{$self->{'rows'}};
+}
+
+
+
+
+=head2 GetColumnIndx($self, $column_name)
+
+ Return the 0 based index of the column named $column_name. Use
+ this to speed up (slightly) access to column values when accessing
+ many or all rows of a table.
+
+=cut
+sub GetColumnIndex ($$)
+{
+ my ($self, $column_name) = @_;
+
+ my $index = 0;
+ foreach my $name (@{$self->{'columns'}})
+ {
+ if ($name eq $column_name)
+ {
+ return $index;
+ }
+ ++$index;
+ }
+
+ printf STDERR ("did not find column %s in %s\n", $column_name, join(" and ", @{$self->{'columns'}}));
+ return -1;
+}
+
+
+
+=head2 GetRowIndex($self, $index_column_index, $index_column_value)
+
+ Return the index, starting at 0, of the (first) row that has value $index_column_value
+ in column with index $index_column_index.
+
+ Return -1 if now such row is found.
+
+=cut
+sub GetRowIndex ($$$)
+{
+ my ($self, $index_column_index, $index_column_value) = @_;
+
+ my $rows = $self->{'rows'};
+ for (my ($row_index,$row_count)=(0,scalar @$rows); $row_index<$row_count; ++$row_index)
+ {
+ my $row = $rows->[$row_index];
+ if ($row->GetValue($index_column_index) eq $index_column_value)
+ {
+ return $row_index;
+ }
+ }
+
+ return -1;
+}
+
+
+
+
+=head2 GetValue($self, $selector_column, $selector_column_value, $value_column)
+
+ Find the row in which the $selector_column has value
+ $selector_column_value and return its value in the $value_column.
+
+=cut
+
+sub GetValue ($$$$)
+{
+ my ($self, $selector_column, $selector_column_value, $value_column) = @_;
+
+ my $row = $self->GetRow($selector_column, $selector_column_value);
+ if (defined $row)
+ {
+ return $row->GetValue($value_column);
+ }
+ else
+ {
+ return undef;
+ }
+}
+
+
+
+
+=head2 GetRow($self, $column, $value)
+
+ Return the (first) row which has $value in $column.
+
+=cut
+sub GetRow ($$$)
+{
+ my ($self, $column, $value) = @_;
+
+ my $column_index = $self->GetColumnIndex($column);
+ if ($column_index<0)
+ {
+ printf STDERR "ERROR: unknown column $column in table $self->{'name'}\n";
+ return undef;
+ }
+
+ foreach my $row (@{$self->{'rows'}})
+ {
+ if ($row->GetValue($column_index) eq $value)
+ {
+ return $row;
+ }
+ }
+
+ printf STDERR ("ERROR: did not find row for %s->%s in %s\n",
+ $column,
+ $value,
+ table $self->{'name'});
+
+ return undef;
+}
+
+
+
+
+=head2 GetAllRows ($self)
+
+ Return the reference to an array that contains all rows of the table.
+
+=cut
+
+sub GetAllRows ($)
+{
+ my $self = shift;
+
+ return $self->{'rows'};
+}
+
+
+
+
+=head2 SetRow($self, {$key, $value}*)
+
+ Replace an existing row. If no matching row is found then add the row.
+
+ The row is defined by a set of key/value pairs. Their order is defined by the keys (column names)
+ and their indices as defined in $self->{'columns'}.
+
+ Rows are compared by their values of the index column. By default this is the first element of
+ $self->{'index_columns'} but is overruled by the last key that starts with a '*'.
+
+=cut
+sub SetRow ($@)
+{
+ my $self = shift;
+ my @data = @_;
+
+ my @items = ();
+ my $index_column = $self->{'index_columns'}->[0];
+
+ # Key/Value has to have an even number of entries.
+ MsiTools::Die("invalid arguments given to MsiTable::SetRow()\n") if (scalar @data%2) != 0;
+
+ # Find column indices for column names.
+ while (scalar @data > 0)
+ {
+ my $column_name = shift @data;
+ if ($column_name =~ /^\*(.*)$/)
+ {
+ # Column name starts with a '*'. Use it as index column.
+ $column_name = $1;
+ $index_column = $1;
+ }
+ my $value = shift @data;
+ my $column_index = $self->GetColumnIndex($column_name);
+ $items[$column_index] = $value;
+ }
+
+ my $index_column_index = $self->GetColumnIndex($index_column);
+ my $row_index = $self->GetRowIndex($index_column_index, $items[$index_column_index]);
+
+ if ($row_index < 0)
+ {
+ # Row does not yet exist. Add it.
+ push @{$self->{'rows'}}, installer::patch::MsiRow->new($self, @items);
+ }
+ else
+ {
+ # Row does already exist. Replace it.
+ $self->{'rows'}->[$row_index] = installer::patch::MsiRow->new($self, @items);
+ }
+
+ $self->MarkAsModified();
+}
+
+
+
+
+sub MarkAsModified ($)
+{
+ my $self = shift;
+
+ $self->{'is_modified'} = 1;
+}
+
+
+
+
+sub MarkAsUnmodified ($)
+{
+ my $self = shift;
+
+ $self->{'is_modified'} = 0;
+}
+
+
+
+
+sub IsModified ($)
+{
+ my $self = shift;
+
+ return $self->{'is_modified'};
+}
+
+
+1;
Modified: openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/ReleasesList.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/ReleasesList.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/ReleasesList.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/ReleasesList.pm Wed Dec 11 08:49:16 2013
@@ -1,210 +1,546 @@
-#**************************************************************
-#
-# Licensed to the Apache Software Foundation (ASF) under one
-# or more contributor license agreements. See the NOTICE file
-# distributed with this work for additional information
-# regarding copyright ownership. The ASF licenses this file
-# to you under the Apache License, Version 2.0 (the
-# "License"); you may not use this file except in compliance
-# with the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing,
-# software distributed under the License is distributed on an
-# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
-# KIND, either express or implied. See the License for the
-# specific language governing permissions and limitations
-# under the License.
-#
-#**************************************************************
-
-package installer::patch::ReleasesList;
-
-use XML::LibXML;
-use File::Spec;
-use strict;
-
-=head1 NAME
-
- package installer::patch::ReleasesList - Functions for accessing the instsetoo_native/data/releases.xml file
-
-=cut
-
-
-my $Instance = undef;
-
-=head2 Instance()
-
- Return the singleton instance.
-
-=cut
-sub Instance()
-{
- if ( ! defined $Instance)
- {
- $Instance = new installer::patch::ReleasesList();
- }
- return $Instance;
-}
-
-
-
-
-=head2 new($class)
-
- Internal constructor. Don't call.
-
-=cut
-sub new ($)
-{
- my ($class) = @_;
-
- my $self = {};
- bless($self, $class);
-
- $self->Read();
-
- return $self;
-}
-
-
-
-
-=head2 GetFirstChild ($node, $child_name)
-
- Internal function that returns the first child. Use only when the
- first child is the (expected) only child in a list.
-
-=cut
-sub GetFirstChild ($$)
-{
- my ($node, $child_name) = @_;
-
- if ( ! defined $node)
- {
- return undef;
- }
- else
- {
- my @child_nodes = $node->getElementsByTagName($child_name);
- if (scalar @child_nodes == 0)
- {
- return undef;
- }
- else
- {
- return $child_nodes[0];
- }
- }
-}
-
-
-
-
-=head2 GetText ($node)
-
- Internal function that returns the trimmed text content of a node.
-
-=cut
-sub GetText ($)
-{
- my ($node) = @_;
-
- if ( ! defined $node)
- {
- return "";
- }
- else
- {
- my $text = $node->textContent();
- $text =~ s/(^\s+|\s+$)//g;
- return $text;
- }
-}
-
-
-
-
-=head2 Read($self)
-
- Read the releases.xml file as doctree and parse its content.
-
-=cut
-sub Read ($)
-{
- my ($self) = @_;
-
- my $filename = File::Spec->catfile($ENV{'SRC_ROOT'}, "instsetoo_native", "data", "releases.xml");
- my $parser = XML::LibXML->new();
- my $document = $parser->parse_file($filename);
- foreach my $release_node ($document->getElementsByTagName("release"))
- {
- my $version_node = GetFirstChild($release_node, "version");
- my $version = GetText($version_node);
- next if $version eq "";
-
- foreach my $download_node (GetFirstChild($release_node, "download"))
- {
- my $package_node = GetFirstChild($download_node, "package-format");
- my $package_format = GetText($package_node);
- next if $package_format eq "";
-
- my $download_data = ParseDownloadData($download_node);
- if (defined $download_data)
- {
- $self->{$version}->{$package_format} = $download_data;
- }
- }
- }
-
-}
-
-
-
-
-=head2 ParseDownloadData ($download_node)
-
- Parse the data for one set of download data (there is one per release and package format).
-
-=cut
-sub ParseDownloadData ($)
-{
- my ($download_node) = @_;
-
- my $url_node = GetFirstChild($download_node, "url-template");
- my $url_template = GetText($url_node);
- if ($url_template eq "")
- {
- print STDERR "releases data file corrupt (no URL template)\n";
- return undef;
- }
-
- my $download_data = {};
- foreach my $item_node (@{$download_node->getElementsByTagName("item")})
- {
- my $language = GetText(GetFirstChild($item_node, "language"));
- my $checksum_node = GetFirstChild($item_node, "checksum");
- if ( ! defined $checksum_node)
- {
- print STDERR "releases data file corrupt (item has no 'checksum' node)\n";
- return undef;
- }
- my $checksum_type = $checksum_node->getAttribute("type");
- my $checksum_value = GetText($checksum_node);
- my $file_size = GetText(GetFirstChild($item_node, "size"));
-
- my $url = $url_template;
- $url =~ s/\%L/$language/g;
- $download_data->{$language} = {
- 'URL' => $url,
- 'checksum-type' => $checksum_type,
- 'checksum-value' => $checksum_value,
- 'file-size' => $file_size
- };
- }
-
- return $download_data;
-}
-
-1;
+#**************************************************************
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+#**************************************************************
+
+package installer::patch::ReleasesList;
+
+use XML::Parser;
+use File::Spec;
+
+use strict;
+
+=head1 NAME
+
+ package installer::patch::ReleasesList - Functions for accessing the instsetoo_native/data/releases.xml file
+
+=cut
+
+
+my $Instance = undef;
+
+=head2 Instance()
+
+ Return the singleton instance.
+
+=cut
+sub Instance()
+{
+ if ( ! defined $Instance)
+ {
+ $Instance = new installer::patch::ReleasesList(
+ File::Spec->catfile($ENV{'SRC_ROOT'}, "instsetoo_native", "data", "releases.xml"));
+ }
+ return $Instance;
+}
+
+
+
+
+=head2 new($class, $filename)
+
+ Internal constructor. Don't call.
+
+=cut
+sub new ($$)
+{
+ my ($class, $filename) = @_;
+
+ my $self = {
+ 'releases' => []
+ };
+ bless($self, $class);
+
+
+ $self->Read($filename);
+
+
+ return $self;
+}
+
+
+
+
+=head2 GetFirstChild ($node, $child_name)
+
+ Internal function that returns the first child. Use only when the
+ first child is the (expected) only child in a list.
+
+=cut
+sub GetFirstChild ($$)
+{
+ my ($node, $child_name) = @_;
+
+ if ( ! defined $node)
+ {
+ return undef;
+ }
+ else
+ {
+ my $value = $node->{$child_name};
+ if (ref($value) eq 'ARRAY')
+ {
+ return $value->[0];
+ }
+ else
+ {
+ return $value;
+ }
+ }
+}
+
+
+
+
+=head2 GetText ($node)
+
+ Internal function that returns the trimmed text content of a node.
+
+=cut
+sub GetText ($;$)
+{
+ my ($node, $default_text) = @_;
+
+ if ( ! defined $node)
+ {
+ if (defined $default_text)
+ {
+ return $default_text;
+ }
+ else
+ {
+ return "";
+ }
+ }
+ else
+ {
+ my $text = $node->{'__text__'};
+ $text =~ s/(^\s+|\s+$)//g;
+ return $text;
+ }
+}
+
+
+
+sub GetAttribute ($$)
+{
+ my ($node, $attribute_name) = @_;
+
+ my $attributes = $node->{'__attributes__'};
+ if ( ! defined $attributes)
+ {
+ return undef;
+ }
+ else
+ {
+ return $attributes->{$attribute_name};
+ }
+}
+
+
+
+
+sub PrintNode($$);
+
+=head2 ReadDomTree ($filename)
+
+ Read the dom tree for the XML in $filename.
+
+ Note that
+ a) this was initially written for another XML library that provided the dom tree directly.
+ b) the dom tree creation is basic and simple but good enough for the current format.
+ When the format should change substantially, then we may need a better parser.
+
+=cut
+sub ReadDomTree ($)
+{
+ my ($filename) = @_;
+
+ my $root = {};
+ my $data = {
+ 'current_node' => $root,
+ 'node_stack' => []
+ };
+ my $parser = new XML::Parser(
+ 'Handlers' => {
+ 'Start' => sub {HandleStartTag($data, @_)},
+ 'End' => sub{HandleEndTag($data, @_)},
+ 'Char' => sub{HandleText($data, @_)}
+ });
+ $parser->parsefile($filename);
+
+# PrintNode("", $root);
+
+ return $root;
+}
+
+
+
+
+=head HandleStartTag ($data, $expat, $element_name, @attributes)
+
+ Callback for start tags.
+
+ A new hash is appended to the array that is referenced by the parent by $element_name.
+ That means that when this function ends there the new hash can be referenced by
+ my $parent = $data->{'node_stack'}->[-1];
+ my $new_hash = $parent->{$element_name}->[-1];
+
+ Note that, just like in other implementations of dom trees,
+ $parent->{$element_name} is an array, even when there is only one
+ element.
+
+ The new hash is empty or contains the given @attributes as hash.
+ When fully read (ie its end tag has been processed) then it can contain two special keys:
+ __attributes__ for the attributes
+ __text__ for the concatenated text parts
+
+=cut
+sub HandleStartTag ($$$@)
+{
+ my ($data, $expat, $element_name, @attributes) = @_;
+
+ # Create new node with attributes.
+ my $node = {'__attributes__' => {@attributes}};
+
+ # Append it to the list of $element_name objects.
+ my $current_node = $data->{'current_node'};
+ $current_node->{$element_name} = [] unless defined $current_node->{$element_name};
+ push @{$current_node->{$element_name}}, $node;
+
+ # Make the new node the current node.
+ push @{$data->{'node_stack'}}, $current_node;
+ $data->{'current_node'} = $node;
+}
+
+=head HandleEndTag ($data, $expat, $element_name, @attributes)
+
+ Callback for end tags.
+
+=cut
+sub HandleEndTag ($$$)
+{
+ my ($data, $expat, $element) = @_;
+
+ # Restore the parent node as current node.
+ $data->{'current_node'} = pop @{$data->{'node_stack'}};
+}
+
+=head2 HandleText ($data, $expat, $text)
+
+ Callback for text.
+
+ $text is appended to the __text__ member of the current node in
+ the dom tree.
+
+=cut
+sub HandleText ($$$)
+{
+ my ($data, $expat, $text) = @_;
+ if ($text !~ /^\s*$/)
+ {
+ $data->{'current_node'}->{'__text__'} .= $text;
+ }
+}
+
+
+
+
+=head2 PrintNode ($indentation, $node)
+
+ For debugging.
+ Print $node recursively with initial $indentation.
+
+=cut
+sub PrintNode($$)
+{
+ my ($indentation, $node) = @_;
+
+ if (defined $node->{'__attributes__'})
+ {
+ while (my ($name,$attribute) = each(%{$node->{'__attributes__'}}))
+ {
+ printf(" %s%s -> %s\n", $indentation, $name, $attribute);
+ }
+ }
+
+ while (my ($key,$value) = each(%$node))
+ {
+ if ($key eq '__text__')
+ {
+ printf("%stext '%s'\n", $indentation, $value);
+ }
+ elsif ($key eq '__attributes__')
+ {
+ next;
+ }
+ elsif (ref($value) eq "ARRAY")
+ {
+ foreach my $item (@$value)
+ {
+ printf("%s%s {\n", $indentation, $key);
+ PrintNode($indentation." ", $item);
+ printf("%s}\n", $indentation);
+ }
+ }
+ else
+ {
+ printf("%s%s {\n", $indentation, $key);
+ PrintNode($indentation." ", $value);
+ printf("%s}\n", $indentation);
+ }
+ }
+}
+
+
+
+
+=head2 Read($self, $filename)
+
+ Read the releases.xml file as doctree and parse its content.
+
+=cut
+sub Read ($$)
+{
+ my ($self, $filename) = @_;
+
+ my $document = ReadDomTree($filename);
+ foreach my $release_node (@{$document->{'releases'}->[0]->{'release'}})
+ {
+ my $version_node = GetFirstChild($release_node, "version");
+ my $version_major = GetText(GetFirstChild($version_node, "major"));
+ my $version_minor = GetText(GetFirstChild($version_node, "minor"), "0");
+ my $version_micro = GetText(GetFirstChild($version_node, "micro"), "0");
+ my $version = sprintf("%d.%d.%d", $version_major, $version_minor, $version_micro);
+ die "could not read version from releases.xml" if $version eq "";
+
+ push @{$self->{'releases'}}, $version;
+
+ my $download_node = GetFirstChild($release_node, "downloads");
+ my $package_format = GetText(GetFirstChild($download_node, "package-format"));
+ my $url_template = GetText(GetFirstChild($download_node, "url-template"));
+ my $upgrade_code = GetText(GetFirstChild($download_node, "upgrade-code"));
+ my $build_id = GetText(GetFirstChild($download_node, "build-id"));
+ die "could not read package format from releases.xml" if $package_format eq "";
+
+ $self->{$version}->{$package_format}->{'upgrade-code'} = $upgrade_code;
+ $self->{$version}->{$package_format}->{'build-id'} = $build_id;
+ $self->{$version}->{$package_format}->{'url-template'} = $url_template;
+
+ my @languages = ();
+ foreach my $item_node (@{$download_node->{'item'}})
+ {
+ my ($language, $download_data) = ParseDownloadData($item_node, $url_template);
+ if (defined $download_data && defined $language)
+ {
+ push @languages, $language;
+ $self->{$version}->{$package_format}->{$language} = $download_data;
+ }
+ }
+ $self->{$version}->{$package_format}->{'languages'} = \@languages;
+ }
+}
+
+
+
+
+=head2 ParseDownloadData ($item_node, $url_template)
+
+ Parse the data for one set of download data (there is one per release and package format).
+
+=cut
+sub ParseDownloadData ($$)
+{
+ my ($item_node, $url_template) = @_;
+
+ my $language = GetText(GetFirstChild($item_node, "language"));
+ my $checksum_node = GetFirstChild($item_node, "checksum");
+ if ( ! defined $checksum_node)
+ {
+ print STDERR "releases data file corrupt (item has no 'checksum' node)\n";
+ return undef;
+ }
+ my $checksum_type = GetAttribute($checksum_node, "type");
+ my $checksum_value = GetText($checksum_node);
+ my $file_size = GetText(GetFirstChild($item_node, "size"));
+ my $product_code = GetText(GetFirstChild($item_node, "product-code"));
+
+ my $url = $url_template;
+ $url =~ s/\%L/$language/g;
+ return (
+ $language,
+ {
+ 'URL' => $url,
+ 'checksum-type' => $checksum_type,
+ 'checksum-value' => $checksum_value,
+ 'file-size' => $file_size,
+ 'product-code' => $product_code
+ });
+}
+
+
+
+
+=head2 Write($self, $filename)
+
+ Write the content of the releases data to a file named $filename.
+
+=cut
+sub Write ($$)
+{
+ my ($self, $filename) = @_;
+
+ open my $out, ">", $filename || die "can not write releases data to ".$filename;
+ $self->WriteHeader($out);
+ $self->WriteContent($out);
+ close $out;
+}
+
+
+
+
+=head2 WriteContent ($self, $out)
+
+ Write the content of the releases.xml list.
+
+=cut
+sub WriteContent ($$)
+{
+ my ($self, $out) = @_;
+
+ print $out "<releases>\n";
+ # Write the data sets for each releases with the same sort order as @{$self->{'releases'}}
+ foreach my $version (@{$self->{'releases'}})
+ {
+ print $out " <release>\n";
+
+ my @version_array = split(/\./, $version);
+ printf $out " <version>\n";
+ printf $out " <major>%s</major>\n", $version_array[0];
+ printf $out " <minor>%s</minor>\n", $version_array[1];
+ printf $out " <micro>%s</micro>\n", $version_array[2];
+ printf $out " </version>\n";
+
+ # Write one download data set per package format.
+ while (my ($package_format, $data) = each %{$self->{$version}})
+ {
+ print $out " <download>\n";
+ printf $out " <package-format>%s</package-format>\n", $package_format;
+ print $out " <url-template>\n";
+ printf $out " %s\n", $data->{'url-template'};
+ print $out " </url-template>\n";
+ printf $out " <upgrade-code>%s</upgrade-code>\n", $data->{'upgrade-code'};
+ printf $out " <build-id>%s</build-id>\n", $data->{'build-id'};
+
+ foreach my $language (@{$data->{'languages'}})
+ {
+ my $language_data = $data->{$language};
+ print $out " <item>\n";
+ printf $out " <language>%s</language>\n", $language;
+ printf $out " <checksum type=\"%s\">%s</checksum>\n",
+ $language_data->{'checksum-type'},
+ $language_data->{'checksum-value'};
+ printf $out " <size>%s</size>\n", $language_data->{'file-size'};
+ printf $out " <product-code>%s</product-code>\n", $language_data->{'product-code'};
+ print $out " </item>\n";
+ }
+
+ print $out " </download>\n";
+ }
+
+ print $out " </release>\n";
+ }
+
+ print $out "</releases>\n";
+}
+
+
+
+
+=head2 WriteHeader ($self, $out)
+
+ Write the header for the releases.xml list.
+
+=cut
+sub WriteHeader ($$)
+{
+ my ($self, $out) = @_;
+
+print $out <<EOT;
+<?xml version='1.0' encoding='UTF-8'?>
+<!--***********************************************************
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one
+ * or more contributor license agreements. See the NOTICE file
+ * distributed with this work for additional information
+ * regarding copyright ownership. The ASF licenses this file
+ * to you under the Apache License, Version 2.0 (the
+ * "License"); you may not use this file except in compliance
+ * with the License. You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing,
+ * software distributed under the License is distributed on an
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+ * KIND, either express or implied. See the License for the
+ * specific language governing permissions and limitations
+ * under the License.
+ *
+ ***********************************************************-->
+EOT
+}
+
+
+
+
+=head2 GetPreviousVersion($version)
+
+ Look up $version in the sorted list of released versions. Return
+ the previous element. Whe $version is not found then return the
+ last element (under the assumption that $version will be the next
+ released version).
+
+=cut
+sub GetPreviousVersion ($)
+{
+ my ($current_version) = @_;
+
+ my $release_data = installer::patch::ReleasesList::Instance();
+ my $previous_version = undef;
+ foreach my $version (@{$release_data->{'releases'}})
+ {
+ if ($version eq $current_version)
+ {
+ return $previous_version;
+ }
+ else
+ {
+ $previous_version = $version;
+ }
+ }
+
+ return $previous_version;
+}
+
+
+
+
+
+1;
Modified: openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/Tools.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/Tools.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/Tools.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/Tools.pm Wed Dec 11 08:49:16 2013
@@ -1,47 +1,62 @@
-#**************************************************************
-#
-# Licensed to the Apache Software Foundation (ASF) under one
-# or more contributor license agreements. See the NOTICE file
-# distributed with this work for additional information
-# regarding copyright ownership. The ASF licenses this file
-# to you under the Apache License, Version 2.0 (the
-# "License"); you may not use this file except in compliance
-# with the License. You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing,
-# software distributed under the License is distributed on an
-# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
-# KIND, either express or implied. See the License for the
-# specific language governing permissions and limitations
-# under the License.
-#
-#**************************************************************
-
-package installer::patch::Tools;
-
-=head1 NAME
-
- package installer::patch::Tools - Collection of functions that don't fit anywhere else
-
-=cut
-
-
-
-
-=head2 CygpathToWindows ($path)
-
- Convert the given path with the 'cygpath' command into Windows format. Quote backslashes.
-
-=cut
-sub CygpathToWindows($)
-{
- my ($path) = @_;
- my $windows_path = qx(cygpath -w "$path");
- $windows_path =~ s/(^\s+|\s+$)//g;
- $windows_path =~ s/\\/\\\\/g;
- return $windows_path;
-}
-
-1;
+#**************************************************************
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+#**************************************************************
+
+package installer::patch::Tools;
+
+=head1 NAME
+
+ package installer::patch::Tools - Collection of functions that don't fit anywhere else
+
+=cut
+
+
+
+
+=head2 ToEscapedWindowsPath ($path)
+
+ Convert the given path with the 'cygpath' command into Windows format. Quote backslashes.
+
+=cut
+sub ToEscapedWindowsPath($)
+{
+ my ($path) = @_;
+
+ my $windows_path = qx(cygpath -w "$path");
+ $windows_path =~ s/(^\s+|\s+$)//g;
+ $windows_path =~ s/\\/\\\\/g;
+
+ return $windows_path;
+}
+
+
+
+
+sub ToWindowsPath ($)
+{
+ my ($path) = @_;
+
+ my $windows_path = qx(cygpath -w "$path");
+ $windows_path =~ s/(^\s+|\s+$)//g;
+
+ return $windows_path;
+}
+
+1;
Modified: openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/Version.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/Version.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/Version.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/patch/Version.pm Wed Dec 11 08:49:16 2013
@@ -35,7 +35,7 @@ my $VersionPartCount = 3;
-=head StringToNumberArray($version_string)
+=head2 StringToNumberArray($version_string)
Convert a version string (where the individual parts are separated by '.') into an array of three numbers.
Missing numbers are filled with 0.
@@ -57,7 +57,7 @@ sub StringToNumberArray ($)
-=head ArrayToDirectoryName (@)
+=head2 ArrayToDirectoryName (@)
Return a directory name (without any path) for the given array of version numbers.
@@ -69,6 +69,37 @@ sub ArrayToDirectoryName (@)
+=head2 ArrayToNoDotName (@)
+
+ This symply creates a version array (A,B,C) into a version string
+ "ABC" with no dots between major, minor and micro version number.
+
+=cut
+sub ArrayToNoDotName (@)
+{
+ return join("", @_);
+}
+
+
+
+
+=head2 IsMajorVersion ($version_string)
+
+ Return 1 if $version_string is a major version, ie. ?.0.0
+ Return 0 otherwise.
+
+=cut
+sub IsMajorVersion ($)
+{
+ my ($version_string) = @_;
+ my @version = installer::patch::Version::StringToNumberArray($version_string);
+ for (my $index=1; $index<$VersionPartCount; ++$index)
+ {
+ return 0 if $version[$index] ne "0";
+ }
+ return 1;
+}
+
1;
Modified: openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/pathanalyzer.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/pathanalyzer.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/pathanalyzer.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/pathanalyzer.pm Wed Dec 11 08:49:16 2013
@@ -46,6 +46,14 @@ sub get_path_from_fullqualifiedname
}
}
+
+
+
+=head2
+
+ Despite its name, this function seems just to return the basename of the given filename.
+
+=cut
sub make_absolute_filename_to_relative_filename
{
my ($longfilenameref) = @_;
Modified: openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/scppatchsoname.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/scppatchsoname.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/scppatchsoname.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/scppatchsoname.pm Wed Dec 11 08:49:16 2013
@@ -94,37 +94,18 @@ sub replace_productname_in_file
my $replacestring = "";
for ( my $i = 1; $i <= 80; $i++ ) { $replacestring .= $onestring; }
+ $installer::logger::Lang->printf("processing PATCH_SO_NAME: %s -> %s\n", $sourcepath, $destpath);
+
my $productname = $variableshashref->{'PRODUCTNAME'} . " " . $variableshashref->{'PRODUCTVERSION'};
if ( exists($onefilehash->{'FileDescription'}) ) { $productname = $onefilehash->{'FileDescription'}; }
my $unicode_productname = convert_to_unicode($productname);
change_length_of_string(\$unicode_productname, $replacestring);
- my $found1 = $onefile =~ s/$replacestring/$unicode_productname/sg;
-
- my $found2 = 0;
-
- if ( $styles =~ /\bPATCH_SO_NAME_Z\b/ )
- {
- # searching for "z"
-
- $onestring = "z" . chr(0);
- $replacestring = "";
- for ( my $i = 1; $i <= 80; $i++ ) { $replacestring .= $onestring; }
-
- my $productname2 = $variableshashref->{'PRODUCTNAME'} . " " . $variableshashref->{'PRODUCTVERSION'};
- if ( exists($onefilehash->{'FileDescriptionZ'}) ) { $productname2 = $onefilehash->{'FileDescriptionZ'}; }
- my $unicode_productname2 = convert_to_unicode($productname2);
-
- change_length_of_string_with_letter(\$unicode_productname2, $replacestring, $onestring);
-
- $found2 = $onefile =~ s/$replacestring/$unicode_productname2/sg;
- }
+ my $found = $onefile =~ s/$replacestring/$unicode_productname/sg;
installer::files::save_binary_file($onefile, $destpath);
- my $found = $found1 + $found2;
-
return $found;
}
@@ -173,7 +154,8 @@ sub resolving_patchsoname_flag
# if (!(-f $destinationpath)) # do nothing if the file already exists
# {
-
+
+ $installer::logger::Lang->printf("PATCH_SO_NAME: copying '%s' to '%s'\n", $sourcepath, $movepath);
my $copysuccess = installer::systemactions::copy_one_file($sourcepath, $movepath);
if ( $copysuccess )
Modified: openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/scpzipfiles.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/scpzipfiles.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/scpzipfiles.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/scpzipfiles.pm Wed Dec 11 08:49:16 2013
@@ -29,29 +29,35 @@ use installer::logger;
use installer::pathanalyzer;
use installer::systemactions;
+use strict;
+
########################################################################################
# Replacing all zip list variables in setup script and files with flag scpzip_replace
########################################################################################
-sub replace_all_ziplistvariables_in_file
+sub replace_all_ziplistvariables_in_file ($$)
{
- my ( $fileref, $variableshashref ) = @_;
+ my ($lines, $variables) = @_;
- for ( my $i = 0; $i <= $#{$fileref}; $i++ )
+ my $count = scalar @$lines;
+ for (my $lineno=0; $lineno<$count; ++$lineno)
{
- my $line = ${$fileref}[$i];
-
- if ( $line =~ /^.*\$\{\w+\}.*$/ ) # only occurence of ${abc}
- {
- my $key;
-
- foreach $key (keys %{$variableshashref})
- {
- my $value = $variableshashref->{$key};
- $key = '${' . $key . '}';
- $line =~ s/\Q$key\E/$value/g;
- ${$fileref}[$i] = $line;
+ my $line = $lines->[$lineno];
+ if ($line =~ /\$\{/) # early rejection of lines that don't need replacements
+ {
+ while (my ($key,$value) = each %$variables)
+ {
+ my $pattern = '${' . $key . '}';
+ my $replacement_count = ($line =~ s/\Q$pattern\E/$value/g);
+ if ($key eq "PRODUCTADDON" && $replacement_count>0)
+ {
+ $installer::logger::Lang->printf(
+ "replaced PRODUCTADDON %d times in line %d\n",
+ $replacement_count,
+ $lineno);
+ }
}
+ $lines->[$lineno] = $line;
}
}
}
@@ -61,39 +67,26 @@ sub replace_all_ziplistvariables_in_file
# the brackets are masked.
########################################################################################
-sub replace_all_ziplistvariables_in_rtffile
+sub replace_all_ziplistvariables_in_rtffile ($$)
{
- my ( $fileref, $variablesref, $onelanguage, $loggingdir ) = @_;
-
- # installer::files::save_file($loggingdir . "license_" . $onelanguage . "_before.rtf", $fileref);
+ my ($lines, $variables) = @_;
- for ( my $i = 0; $i <= $#{$fileref}; $i++ )
+ my $line_count = scalar @$lines;
+ for (my $i=0; $i<=$line_count; ++$i)
{
- my $line = ${$fileref}[$i];
+ my $line = $lines->[$i];
- if ( $line =~ /^.*\$\\\{\w+\\\}.*$/ ) # only occurence of $\{abc\}
- {
- for ( my $j = 0; $j <= $#{$variablesref}; $j++ )
+ if ($line =~ /\$\\\{/) # early rejection of lines without variable references
+ {
+ while (my ($key, $value) = each (%$variables))
{
- my $variableline = ${$variablesref}[$j];
-
- my ($key, $value);
-
- if ( $variableline =~ /^\s*([\w-]+?)\s+(.*?)\s*$/ )
- {
- $key = $1;
- $value = $2;
- $key = '$\{' . $key . '\}';
- }
-
+ my $pattern = '$\{' . $key . '\}';
$line =~ s/\Q$key\E/$value/g;
- ${$fileref}[$i] = $line;
}
+ $lines->[$i] = $line;
}
}
-
- # installer::files::save_file($loggingdir . "license_" . $onelanguage . "_after.rtf", $fileref);
}
#########################################################
Modified: openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/scriptitems.pm
URL: http://svn.apache.org/viewvc/openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/scriptitems.pm?rev=1550072&r1=1550071&r2=1550072&view=diff
==============================================================================
--- openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/scriptitems.pm (original)
+++ openoffice/branches/rejuvenate01/main/solenv/bin/modules/installer/scriptitems.pm Wed Dec 11 08:49:16 2013
@@ -37,6 +37,8 @@ use File::Spec;
use SvnRevision;
use ExtensionsLst;
+use strict;
+
################################################################
# Resolving the GID for the directories defined in setup script
################################################################
@@ -45,8 +47,6 @@ sub resolve_all_directory_names
{
my ($directoryarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::resolve_all_directory_names : $#{$directoryarrayref}"); }
-
# After this procedure the hash shall contain the complete language
# dependent path, not only the language dependent HostName.
@@ -160,8 +160,6 @@ sub remove_delete_only_files_from_produc
{
my ($productarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::remove_delete_only_files_from_productlists : $#{$productarrayref}"); }
-
my @newitems = ();
for ( my $i = 0; $i <= $#{$productarrayref}; $i++ )
@@ -189,8 +187,6 @@ sub remove_notinsuite_files_from_product
{
my ($productarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::remove_notinsuite_files_from_productlists : $#{$productarrayref}"); }
-
my @newitems = ();
for ( my $i = 0; $i <= $#{$productarrayref}; $i++ )
@@ -223,8 +219,6 @@ sub remove_office_start_language_files
{
my ($productarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::remove_notinsuite_files_from_productlists : $#{$productarrayref}"); }
-
my @newitems = ();
for ( my $i = 0; $i <= $#{$productarrayref}; $i++ )
@@ -257,8 +251,6 @@ sub remove_uninstall_regitems_from_scrip
{
my ($registryarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::remove_uninstall_regitems_from_script : $#{$registryarrayref}"); }
-
my @newitems = ();
for ( my $i = 0; $i <= $#{$registryarrayref}; $i++ )
@@ -310,8 +302,6 @@ sub resolving_all_languages_in_productli
{
my ($productarrayref, $languagesarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::resolving_all_languages_in_productlists : $#{$productarrayref} : $#{$languagesarrayref}"); }
-
my @itemsinalllanguages = ();
my ($key, $value);
@@ -894,8 +884,6 @@ sub changing_name_of_language_dependent_
{
my ($itemsarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::changing_name_of_language_dependent_keys : $#{$itemsarrayref}"); }
-
# Changing key for multilingual items from "Name ( )" to "Name" or "HostName ( )" to "HostName"
for ( my $i = 0; $i <= $#{$itemsarrayref}; $i++ )
@@ -962,8 +950,6 @@ sub replace_setup_variables
{
my ($itemsarrayref, $languagestringref, $hashref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::replace_setup_variables : $#{$itemsarrayref} : $$languagestringref : $hashref->{'PRODUCTNAME'}"); }
-
my $languagesstring = $$languagestringref;
$languagesstring =~ s/\_/ /g; # replacing underscore with whitespace
# $languagesstring is "01 49" instead of "en-US de"
@@ -1027,19 +1013,24 @@ sub replace_setup_variables
# the standard destination of user directory defined in scp2 ($SYSUSERCONFIG).
################################################################################
-sub replace_userdir_variable
+sub replace_userdir_variable ($$)
{
- my ($itemsarrayref) = @_;
+ my ($itemsarrayref, $allvariableshashref) = @_;
my $userdir = "";
- if ( $allvariableshashref->{'LOCALUSERDIR'} ) { $userdir = $allvariableshashref->{'LOCALUSERDIR'}; }
- else { $userdir = $installer::globals::simpledefaultuserdir; }
+ if ($allvariableshashref->{'LOCALUSERDIR'})
+ {
+ $userdir = $allvariableshashref->{'LOCALUSERDIR'};
+ }
+ else
+ {
+ $userdir = $installer::globals::simpledefaultuserdir;
+ }
- if ( $userdir ne "" )
+ if ($userdir ne "")
{
- for ( my $i = 0; $i <= $#{$itemsarrayref}; $i++ )
+ foreach my $oneitem (@$itemsarrayref)
{
- my $oneitem = ${$itemsarrayref}[$i];
$oneitem->{'Value'} =~ s/\$SYSUSERCONFIG/$userdir/;
}
}
@@ -1056,8 +1047,6 @@ sub remove_non_existent_languages_in_pro
{
my ($itemsarrayref, $languagestringref, $searchkey, $itemtype) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::remove_non_existent_languages_in_productlists : $#{$itemsarrayref} : $$languagestringref : $searchkey : $itemtype"); }
-
# Removing of all non existent files, for instance asian fonts
installer::logger::include_header_into_logfile("Removing for this language $$languagestringref:");
@@ -1105,8 +1094,6 @@ sub get_Directoryname_From_Directorygid
{
my ($dirsarrayref ,$searchgid, $onelanguage, $oneitemgid) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::get_Directoryname_From_Directorygid : $#{$dirsarrayref} : $searchgid : $onelanguage"); }
-
my $directoryname = "";
my $onedirectory;
my $foundgid = 0;
@@ -1158,8 +1145,6 @@ sub get_Destination_Directory_For_Item_F
{
my ($itemarrayref, $dirsarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::get_Destination_Directory_For_Item_From_Directorylist : $#{$itemarrayref} : $#{$dirsarrayref}"); }
-
for ( my $i = 0; $i <= $#{$itemarrayref}; $i++ )
{
my $oneitem = ${$itemarrayref}[$i];
@@ -1221,8 +1206,6 @@ sub get_sourcepath_from_filename_and_inc
{
my ($searchfilenameref, $includepatharrayref, $write_logfile) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::get_sourcepath_from_filename_and_includepath_classic : $$searchfilenameref : $#{$includepatharrayref} : $write_logfile"); }
-
my ($onefile, $includepath, $infoline);
my $foundsourcefile = 0;
@@ -1279,8 +1262,6 @@ sub get_sourcepath_from_filename_and_inc
{
my ($searchfilenameref, $unused, $write_logfile) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::get_sourcepath_from_filename_and_includepath : $$searchfilenameref : $#{$includepatharrayref} : $write_logfile"); }
-
my ($onefile, $includepath, $infoline);
my $foundsourcefile = 0;
@@ -1391,8 +1372,6 @@ sub get_Source_Directory_For_Files_From_
{
my ($filesarrayref, $includepatharrayref, $dirsref, $item) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::get_Source_Directory_For_Files_From_Includepathlist : $#{$filesarrayref} : $#{$includepatharrayref} : $item"); }
-
installer::logger::include_header_into_logfile("$item:");
my $infoline = "";
@@ -1487,8 +1466,6 @@ sub remove_Files_For_Languagepacks
{
my ($itemsarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::remove_Files_For_Languagepacks : $#{$filesarrayref}"); }
-
my $infoline;
my @newitemsarray = ();
@@ -1523,8 +1500,6 @@ sub remove_Files_Without_Sourcedirectory
{
my ($filesarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::remove_Files_Without_Sourcedirectory : $#{$filesarrayref}"); }
-
my $infoline;
my $error_occured = 0;
@@ -1635,8 +1610,6 @@ sub add_License_Files_into_Installdir
{
my ($filesarrayref, $dirsarrayref, $languagesarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::add_License_Files_into_Installdir : $#{$filesarrayref} : $#{$languagesarrayref}"); }
-
my $infoline;
my @newfilesarray = ();
@@ -1908,8 +1881,6 @@ sub remove_scpactions_without_name
{
my ($itemsarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::remove_scpactions_without_name : $#{$itemsarrayref}"); }
-
my $infoline;
my @newitemsarray = ();
@@ -1944,8 +1915,6 @@ sub change_keys_of_scpactions
{
my ($itemsarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::change_keys_of_scpactions : $#{$itemsarrayref}"); }
-
for ( my $i = 0; $i <= $#{$itemsarrayref}; $i++ )
{
my $oneitem = ${$itemsarrayref}[$i];
@@ -1989,8 +1958,6 @@ sub remove_Xpdonly_Items
{
my ($itemsarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::remove_Xpdonly_Items : $#{$itemsarrayref}"); }
-
my $infoline;
my @newitemsarray = ();
@@ -2027,8 +1994,6 @@ sub remove_Languagepacklibraries_from_In
{
my ($itemsarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::remove_Languagepacklibraries_from_Installset : $#{$itemsarrayref}"); }
-
my $infoline;
my @newitemsarray = ();
@@ -2065,8 +2030,6 @@ sub remove_patchonlyfiles_from_Installse
{
my ($itemsarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::remove_patchonlyfiles_from_Installset : $#{$itemsarrayref}"); }
-
my $infoline;
my @newitemsarray = ();
@@ -2103,8 +2066,6 @@ sub remove_tabonlyfiles_from_Installset
{
my ($itemsarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::remove_tabonlyfiles_from_Installset : $#{$itemsarrayref}"); }
-
my $infoline;
my @newitemsarray = ();
@@ -2141,8 +2102,6 @@ sub remove_installedproductonlyfiles_fro
{
my ($itemsarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::remove_installedproductonlyfiles_from_Installset : $#{$itemsarrayref}"); }
-
my $infoline;
my @newitemsarray = ();
@@ -2178,8 +2137,6 @@ sub quoting_illegal_filenames
{
my ($filesarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::rename_illegal_filenames : $#{$filesarrayref}"); }
-
# This function has to be removed as soon as possible!
installer::logger::include_header_into_logfile("Renaming illegal filenames:");
@@ -2243,8 +2200,6 @@ sub collect_directories_from_filesarray
{
my ($filesarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::collect_directories_from_filesarray : $#{$filesarrayref}"); }
-
my @alldirectories = ();
my %alldirectoryhash = ();
@@ -2349,12 +2304,10 @@ sub collect_directories_from_filesarray
# Collecting directories: Part 2
##################################
-sub collect_directories_with_create_flag_from_directoryarray
+sub collect_directories_with_create_flag_from_directoryarray ($$)
{
my ($directoryarrayref, $alldirectoryhash) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::collect_directories_with_create_flag_from_directoryarray : $#{$directoryarrayref}"); }
-
my $alreadyincluded = 0;
my @alldirectories = ();
@@ -2362,7 +2315,7 @@ sub collect_directories_with_create_flag
{
my $onedir = ${$directoryarrayref}[$i];
my $styles = "";
- $newdirincluded = 0;
+ my $newdirincluded = 0;
if ( $onedir->{'Styles'} ) { $styles = $onedir->{'Styles'}; }
@@ -2467,19 +2420,17 @@ sub collect_directories_with_create_flag
push(@alldirectories, $alldirectoryhash->{$destdir});
}
- return (\@alldirectories, \%alldirectoryhash);
+ return (\@alldirectories, $alldirectoryhash);
}
#################################################
# Determining the destination file of a link
#################################################
-sub get_destination_file_path_for_links
+sub get_destination_file_path_for_links ($$)
{
my ($linksarrayref, $filesarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::get_destination_file_path_for_links : $#{$linksarrayref} : $#{$filesarrayref}"); }
-
my $infoline;
for ( my $i = 0; $i <= $#{$linksarrayref}; $i++ )
@@ -2521,30 +2472,27 @@ sub get_destination_file_path_for_links
# Determining the destination link of a link
#################################################
-sub get_destination_link_path_for_links
+sub get_destination_link_path_for_links ($)
{
my ($linksarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::get_destination_link_path_for_links : $#{$linksarrayref}"); }
-
my $infoline;
- for ( my $i = 0; $i <= $#{$linksarrayref}; $i++ )
+ foreach my $onelink (@$linksarrayref)
{
my $shortcutid = "";
- my $onelink = ${$linksarrayref}[$i];
- if ( $onelink->{'ShortcutID'} ) { $shortcutid = $onelink->{'ShortcutID'}; }
+ if ($onelink->{'ShortcutID'})
+ {
+ $shortcutid = $onelink->{'ShortcutID'};
+ }
- if (!( $shortcutid eq "" ))
+ if ($shortcutid ne "")
{
my $foundlink = 0;
- for ( my $j = 0; $j <= $#{$linksarrayref}; $j++ )
+ foreach my $destlink (@$linksarrayref)
{
- my $destlink = ${$linksarrayref}[$j];
- $shortcutgid = $destlink->{'gid'};
-
- if ( $shortcutgid eq $shortcutid )
+ if ($destlink->{'gid'} eq $shortcutid)
{
$foundlink = 1;
$onelink->{'destinationfile'} = $destlink->{'destination'}; # making key 'destinationfile'
@@ -2552,7 +2500,7 @@ sub get_destination_link_path_for_links
}
}
- if (!($foundlink))
+ if ( ! $foundlink)
{
$installer::logger::Lang->printf("Warning: ShortcutID %s for Link %s not found!\n",
$shortcutid,
@@ -2572,8 +2520,6 @@ sub remove_workstation_only_items
{
my ($itemarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::remove_workstation_only_items : $#{$itemarrayref}"); }
-
my @newitemarray = ();
for ( my $i = 0; $i <= $#{$itemarrayref}; $i++ )
@@ -2602,8 +2548,6 @@ sub resolve_links_with_flag_relative
{
my ($linksarrayref) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::resolve_links_with_flag_relative : $#{$linksarrayref}"); }
-
# Before this step is:
# destination=program/libsalhelperC52.so.3, this will be the name of the link
# destinationfile=program/libsalhelperC52.so.3, this will be the linked file or name
@@ -2665,7 +2609,7 @@ sub insert_for_item ($$$)
$hash->{$item} = $gid_list;
}
-sub build_modulegids_table
+sub build_modulegids_table ($$)
{
my ($modulesref, $itemname) = @_;
@@ -2673,9 +2617,10 @@ sub build_modulegids_table
# build map of item names to list of respective module gids
# containing these items
- for my $onemodule (@{$modulesref})
+ foreach my $onemodule (@$modulesref)
{
- next if ( ! defined $onemodule->{$itemname} );
+ next if ! defined $onemodule->{$itemname};
+
# these are the items contained in this module
# eg. Files = (gid_a_b_c,gid_d_e_f)
my $module_gids = $onemodule->{$itemname};
@@ -2698,38 +2643,45 @@ sub build_modulegids_table
# This function is a helper of function "assigning_modules_to_items"
########################################################################
-sub get_string_of_modulegids_for_itemgid
+sub get_string_of_modulegids_for_itemgid ($$)
{
- my ($module_lookup_table, $modulesref, $itemgid, $itemname) = @_;
+ my ($module_lookup_table, $itemgid) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::get_string_of_modulegids_for_itemgid : $#{$modulesref} : $itemgid : $itemname"); }
-
- my $allmodules = "";
my $haslanguagemodule = 0;
my %foundmodules = ();
- # print STDERR "lookup '" . lc($itemgid) . "'\n";
my $gid_list = $module_lookup_table->{lc($itemgid)};
- for my $gid (@{$gid_list})
+ foreach my $gid (@$gid_list)
{
$foundmodules{$gid} = 1;
- $allmodules = $allmodules . "," . $gid;
# Is this module a language module? This info should be stored at the file.
- if ( exists($installer::globals::alllangmodules{$gid}) ) { $haslanguagemodule = 1; }
+ if ( exists($installer::globals::alllangmodules{$gid}) )
+ {
+ $haslanguagemodule = 1;
+ }
}
- $allmodules =~ s/^\s*\,//; # removing leading comma
+ my $allmodules = join(",", keys %foundmodules);
# Check: All modules or no module must have flag LANGUAGEMODULE
if ( $haslanguagemodule )
{
- my $isreallylanguagemodule = installer::worker::key_in_a_is_also_key_in_b(\%foundmodules, \%installer::globals::alllangmodules);
- if ( ! $isreallylanguagemodule ) { installer::exiter::exit_program("ERROR: \"$itemgid\" is assigned to modules with flag \"LANGUAGEMODULE\" and also to modules without this flag! Modules: $allmodules", "get_string_of_modulegids_for_itemgid"); }
+ my $isreallylanguagemodule = installer::worker::key_in_a_is_also_key_in_b(
+ \%foundmodules,
+ \%installer::globals::alllangmodules);
+ if ( ! $isreallylanguagemodule )
+ {
+ installer::exiter::exit_program(
+ sprintf(
+ "ERROR: \"%s\" is assigned to modules with flag "
+ ."\"LANGUAGEMODULE\" and also to modules without this flag! Modules: %s",
+ $itemgid,
+ $allmodules),
+ "get_string_of_modulegids_for_itemgid");
+ }
}
- # print STDERR "get_string_for_itemgid ($itemgid, $itemname) => $allmodules, $haslanguagemodule\n";
-
return ($allmodules, $haslanguagemodule);
}
@@ -2742,9 +2694,6 @@ sub assigning_modules_to_items
{
my ($modulesref, $itemsref, $itemname) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::assigning_modules_to_items : $#{$modulesref} : $#{$itemsref} : $itemname"); }
-
- my $infoline = "";
my $languageassignmenterror = 0;
my @languageassignmenterrors = ();
@@ -2760,34 +2709,48 @@ sub assigning_modules_to_items
if ( $itemgid eq "" )
{
- installer::exiter::exit_program("ERROR in item collection: No gid for item $oneitem->{'Name'}", "assigning_modules_to_items");
+ installer::exiter::exit_program(
+ sprintf("ERROR in item collection: No gid for item %s", $oneitem->{'Name'}),
+ "assigning_modules_to_items");
}
# every item can belong to many modules
- my ($modulegids, $haslanguagemodule) = get_string_of_modulegids_for_itemgid($module_lookup_table, $modulesref, $itemgid, $itemname);
+ my ($modulegids, $haslanguagemodule) = get_string_of_modulegids_for_itemgid(
+ $module_lookup_table,
+ $itemgid);
if ($modulegids eq "")
{
- installer::exiter::exit_program("ERROR in file collection: No module found for $itemname $itemgid", "assigning_modules_to_items");
+ installer::exiter::exit_program(
+ sprintf("ERROR in file collection: No module found for %s %s",
+ $itemname,
+ $itemgid),
+ "assigning_modules_to_items");
}
$oneitem->{'modules'} = $modulegids;
$oneitem->{'haslanguagemodule'} = $haslanguagemodule;
# Important check: "ismultilingual" and "haslanguagemodule" must have the same value !
- if (( $oneitem->{'ismultilingual'} ) && ( ! $oneitem->{'haslanguagemodule'} ))
+ if ($oneitem->{'ismultilingual'} && ! $oneitem->{'haslanguagemodule'})
{
- $infoline = "Error: \"$oneitem->{'gid'}\" is multi lingual, but not in language pack (Assigned module: $modulegids)!\n";
+ my $infoline = sprintf(
+ "Error: \"%s\" is multi lingual, but not in language pack (Assigned module: %s)\n",
+ $oneitem->{'gid'},
+ $modulegids);
$installer::logger::Global->print($infoline);
- push( @languageassignmenterrors, $infoline );
+ push(@languageassignmenterrors, $infoline);
$languageassignmenterror = 1;
}
- if (( $oneitem->{'haslanguagemodule'} ) && ( ! $oneitem->{'ismultilingual'} ))
+ elsif ($oneitem->{'haslanguagemodule'} && ! $oneitem->{'ismultilingual'})
{
- $infoline = "Error: \"$oneitem->{'gid'}\" is in language pack, but not multi lingual (Assigned module: $modulegids)!\n";
+ my $infoline = sprintf(
+ "Error: \"%s\" is in language pack, but not multi lingual (Assigned module: %s)\n",
+ $oneitem->{'gid'},
+ $modulegids);
$installer::logger::Global->print($infoline);
- push( @languageassignmenterrors, $infoline );
+ push(@languageassignmenterrors, $infoline);
$languageassignmenterror = 1;
}
}
@@ -2808,8 +2771,6 @@ sub add_rootpath_to_directories
{
my ($dirsref, $rootpath) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::add_rootpath_to_directories : $#{$dirsref} : $rootpath"); }
-
for ( my $i = 0; $i <= $#{$dirsref}; $i++ )
{
my $onedir = ${$dirsref}[$i];
@@ -2839,8 +2800,6 @@ sub add_rootpath_to_files
{
my ($filesref, $rootpath) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::add_rootpath_to_files : $#{$filesref} : $rootpath"); }
-
for ( my $i = 0; $i <= $#{$filesref}; $i++ )
{
my $onefile = ${$filesref}[$i];
@@ -2854,8 +2813,6 @@ sub add_rootpath_to_links
{
my ($linksref, $rootpath) = @_;
- if ( $installer::globals::debug ) { installer::logger::debuginfo("installer::scriptitems::add_rootpath_to_links : $#{$linksref} : $rootpath"); }
-
for ( my $i = 0; $i <= $#{$linksref}; $i++ )
{
my $onelink = ${$linksref}[$i];
@@ -3126,4 +3083,27 @@ sub filter_layerlinks_from_unixlinks
return \@alllinks;
}
+
+
+
+=head2 print_script_item($item)
+
+ For debugging.
+ Print the contents of the given script item to $installer::logger::Lang.
+
+=cut
+sub print_script_item ($)
+{
+ my ($item) = @_;
+
+ $installer::logger::Lang->printf("script item %s\n", $item->{'uniquename'});
+ foreach my $key (sort keys %$item)
+ {
+ my $value = $item->{$key};
+ $value = "<undef>" unless defined $value;
+ $installer::logger::Lang->printf(" %20s -> %s\n", $key, $value);
+ }
+}
+
+
1;