admin.pl (86e1cf34) admin.pl (95e2fe77)
1#**************************************************************
1#**************************************************************
2#
2#
3# Licensed to the Apache Software Foundation (ASF) under one
4# or more contributor license agreements. See the NOTICE file
5# distributed with this work for additional information
6# regarding copyright ownership. The ASF licenses this file
7# to you under the Apache License, Version 2.0 (the
8# "License"); you may not use this file except in compliance
9# with the License. You may obtain a copy of the License at
3# Licensed to the Apache Software Foundation (ASF) under one
4# or more contributor license agreements. See the NOTICE file
5# distributed with this work for additional information
6# regarding copyright ownership. The ASF licenses this file
7# to you under the Apache License, Version 2.0 (the
8# "License"); you may not use this file except in compliance
9# with the License. You may obtain a copy of the License at
10#
10#
11# http://www.apache.org/licenses/LICENSE-2.0
11# http://www.apache.org/licenses/LICENSE-2.0
12#
12#
13# Unless required by applicable law or agreed to in writing,
14# software distributed under the License is distributed on an
15# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
16# KIND, either express or implied. See the License for the
17# specific language governing permissions and limitations
18# under the License.
13# Unless required by applicable law or agreed to in writing,
14# software distributed under the License is distributed on an
15# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
16# KIND, either express or implied. See the License for the
17# specific language governing permissions and limitations
18# under the License.
19#
19#
20#**************************************************************
21
22
23
24use Cwd;
25use File::Copy;
26
27#################################################################################

--- 52 unchanged lines hidden (view full) ---

80
81sub getparameter
82{
83 if (( $#ARGV < 3 ) || ( $#ARGV > 3 )) { usage(); }
84
85 while ( $#ARGV >= 0 )
86 {
87 my $param = shift(@ARGV);
20#**************************************************************
21
22
23
24use Cwd;
25use File::Copy;
26
27#################################################################################

--- 52 unchanged lines hidden (view full) ---

80
81sub getparameter
82{
83 if (( $#ARGV < 3 ) || ( $#ARGV > 3 )) { usage(); }
84
85 while ( $#ARGV >= 0 )
86 {
87 my $param = shift(@ARGV);
88
88
89 if ($param eq "-t") { $targetdir = shift(@ARGV); }
90 elsif ($param eq "-d") { $databasepath = shift(@ARGV); }
91 else
92 {
93 print "\n**********************************************\n";
89 if ($param eq "-t") { $targetdir = shift(@ARGV); }
90 elsif ($param eq "-d") { $databasepath = shift(@ARGV); }
91 else
92 {
93 print "\n**********************************************\n";
94 print "Error: Unknows parameter: $param";
94 print "Error: Unknown parameter: $param";
95 print "\n**********************************************\n";
96 usage();
97 exit(-1);
98 }
99 }
100}
101
102#################################################################################

--- 14 unchanged lines hidden (view full) ---

117 if ( $databasepath eq "" )
118 {
119 print "\n******************************************************\n";
120 print "Error: Path to msi database not defined (parameter -d)!";
121 print "\n******************************************************\n";
122 usage();
123 exit(-1);
124 }
95 print "\n**********************************************\n";
96 usage();
97 exit(-1);
98 }
99 }
100}
101
102#################################################################################

--- 14 unchanged lines hidden (view full) ---

117 if ( $databasepath eq "" )
118 {
119 print "\n******************************************************\n";
120 print "Error: Path to msi database not defined (parameter -d)!";
121 print "\n******************************************************\n";
122 usage();
123 exit(-1);
124 }
125
125
126 if ( -d $databasepath )
127 {
128 $databasepath =~ s/\\\s*$//;
129 $databasepath =~ s/\/\s*$//;
126 if ( -d $databasepath )
127 {
128 $databasepath =~ s/\\\s*$//;
129 $databasepath =~ s/\/\s*$//;
130
130
131 my $msifiles = find_file_with_file_extension("msi", $databasepath);
131 my $msifiles = find_file_with_file_extension("msi", $databasepath);
132
132
133 if ( $#{$msifiles} < 0 ) { exit_program("ERROR: Did not find msi database in directory $installationdir"); }
134 if ( $#{$msifiles} > 0 ) { exit_program("ERROR: Did find more than one msi database in directory $installationdir"); }
135
136 $databasepath = $databasepath . $separator . ${$msifiles}[0];
137 }
138
139 if ( ! -f $databasepath ) { exit_program("ERROR: Did not find msi database in directory $databasepath."); }
133 if ( $#{$msifiles} < 0 ) { exit_program("ERROR: Did not find msi database in directory $installationdir"); }
134 if ( $#{$msifiles} > 0 ) { exit_program("ERROR: Did find more than one msi database in directory $installationdir"); }
135
136 $databasepath = $databasepath . $separator . ${$msifiles}[0];
137 }
138
139 if ( ! -f $databasepath ) { exit_program("ERROR: Did not find msi database in directory $databasepath."); }
140
140
141 if ( ! -d $targetdir ) { create_directories($targetdir); }
142}
143
144#############################################################################
145# The program msidb.exe can be located next to the Perl program. Then it is
141 if ( ! -d $targetdir ) { create_directories($targetdir); }
142}
143
144#############################################################################
145# The program msidb.exe can be located next to the Perl program. Then it is
146# not necessary to find it in the PATH variable.
146# not necessary to find it in the PATH variable.
147#############################################################################
148
149sub check_local_msidb
150{
151 my $msidbname = "msidb.exe";
152 my $perlprogramm = $0;
153 my $path = $perlprogramm;
147#############################################################################
148
149sub check_local_msidb
150{
151 my $msidbname = "msidb.exe";
152 my $perlprogramm = $0;
153 my $path = $perlprogramm;
154
154
155 get_path_from_fullqualifiedname(\$path);
156
157 $path =~ s/\\\s*$//;
158 $path =~ s/\/\s*$//;
159
160 my $msidbpath = "";
161 if ( $path =~ /^\s*$/ ) { $msidbpath = $msidbname; }
162 else { $msidbpath = $path . $separator . $msidbname; }
163
164 if ( -f $msidbpath )
165 {
166 $localmsidbpath = $msidbpath;
167 print "Using $msidbpath (next to \"admin.pl\")\n";
168 }
169}
170
171#############################################################################
155 get_path_from_fullqualifiedname(\$path);
156
157 $path =~ s/\\\s*$//;
158 $path =~ s/\/\s*$//;
159
160 my $msidbpath = "";
161 if ( $path =~ /^\s*$/ ) { $msidbpath = $msidbname; }
162 else { $msidbpath = $path . $separator . $msidbname; }
163
164 if ( -f $msidbpath )
165 {
166 $localmsidbpath = $msidbpath;
167 print "Using $msidbpath (next to \"admin.pl\")\n";
168 }
169}
170
171#############################################################################
172# Converting a string list with separator $listseparator
172# Converting a string list with separator $listseparator
173# into an array
174#############################################################################
175
176sub convert_stringlist_into_array
177{
178 my ( $includestringref, $listseparator ) = @_;
173# into an array
174#############################################################################
175
176sub convert_stringlist_into_array
177{
178 my ( $includestringref, $listseparator ) = @_;
179
179
180 my @newarray = ();
181 my $first;
182 my $last = ${$includestringref};
183
184 while ( $last =~ /^\s*(.+?)\Q$listseparator\E(.+)\s*$/) # "$" for minimal matching
185 {
186 $first = $1;
180 my @newarray = ();
181 my $first;
182 my $last = ${$includestringref};
183
184 while ( $last =~ /^\s*(.+?)\Q$listseparator\E(.+)\s*$/) # "$" for minimal matching
185 {
186 $first = $1;
187 $last = $2;
187 $last = $2;
188 # Problem with two directly following listseparators. For example a path with two ";;" directly behind each other
189 $first =~ s/^$listseparator//;
190 push(@newarray, "$first\n");
188 # Problem with two directly following listseparators. For example a path with two ";;" directly behind each other
189 $first =~ s/^$listseparator//;
190 push(@newarray, "$first\n");
191 }
191 }
192
192
193 push(@newarray, "$last\n");
194
193 push(@newarray, "$last\n");
194
195 return \@newarray;
196}
197
198#########################################################
199# Checking the local system
200# Checking existence of needed files in include path
201#########################################################
202
203sub check_system_path
204{
195 return \@newarray;
196}
197
198#########################################################
199# Checking the local system
200# Checking existence of needed files in include path
201#########################################################
202
203sub check_system_path
204{
205 my $onefile;
205 my $onefile;
206 my $error = 0;
207 my $pathvariable = $ENV{'PATH'};
208 my $local_pathseparator = $pathseparator;
206 my $error = 0;
207 my $pathvariable = $ENV{'PATH'};
208 my $local_pathseparator = $pathseparator;
209
209
210 if( $^O =~ /cygwin/i )
211 { # When using cygwin's perl the PATH variable is POSIX style and ...
212 $pathvariable = qx{cygpath -mp "$pathvariable"} ;
213 # has to be converted to DOS style for further use.
214 $local_pathseparator = ';';
215 }
216 my $patharrayref = convert_stringlist_into_array(\$pathvariable, $local_pathseparator);
210 if( $^O =~ /cygwin/i )
211 { # When using cygwin's perl the PATH variable is POSIX style and ...
212 $pathvariable = qx{cygpath -mp "$pathvariable"} ;
213 # has to be converted to DOS style for further use.
214 $local_pathseparator = ';';
215 }
216 my $patharrayref = convert_stringlist_into_array(\$pathvariable, $local_pathseparator);
217
217
218 my @needed_files_in_path = ("expand.exe");
219 if ( $localmsidbpath eq "" ) { push(@needed_files_in_path, "msidb.exe"); } # not found locally -> search in path
220 my @optional_files_in_path = ("msiinfo.exe");
221
222 print("\nChecking required files:\n");
223
224 foreach $onefile ( @needed_files_in_path )
225 {

--- 4 unchanged lines hidden (view full) ---

230 if ( $$fileref eq "" )
231 {
232 $error = 1;
233 print( "$onefile not found\n" );
234 }
235 else
236 {
237 print( "\tFound: $$fileref\n" );
218 my @needed_files_in_path = ("expand.exe");
219 if ( $localmsidbpath eq "" ) { push(@needed_files_in_path, "msidb.exe"); } # not found locally -> search in path
220 my @optional_files_in_path = ("msiinfo.exe");
221
222 print("\nChecking required files:\n");
223
224 foreach $onefile ( @needed_files_in_path )
225 {

--- 4 unchanged lines hidden (view full) ---

230 if ( $$fileref eq "" )
231 {
232 $error = 1;
233 print( "$onefile not found\n" );
234 }
235 else
236 {
237 print( "\tFound: $$fileref\n" );
238 }
238 }
239 }
240
241 if ( $error ) { exit_program("ERROR: Could not find all needed files in path (using setsolar should help)!"); }
242
243 print("\nChecking optional files:\n");
244
245 foreach $onefile ( @optional_files_in_path )
246 {

--- 5 unchanged lines hidden (view full) ---

252 {
253 print( "$onefile not found\n" );
254 if ( $onefile eq "msiinfo.exe" ) { $msiinfo_available = 0; }
255 }
256 else
257 {
258 print( "\tFound: $$fileref\n" );
259 if ( $onefile eq "msiinfo.exe" ) { $msiinfo_available = 1; }
239 }
240
241 if ( $error ) { exit_program("ERROR: Could not find all needed files in path (using setsolar should help)!"); }
242
243 print("\nChecking optional files:\n");
244
245 foreach $onefile ( @optional_files_in_path )
246 {

--- 5 unchanged lines hidden (view full) ---

252 {
253 print( "$onefile not found\n" );
254 if ( $onefile eq "msiinfo.exe" ) { $msiinfo_available = 0; }
255 }
256 else
257 {
258 print( "\tFound: $$fileref\n" );
259 if ( $onefile eq "msiinfo.exe" ) { $msiinfo_available = 1; }
260 }
260 }
261 }
262
263}
264
265##########################################################################
266# Searching a file in a list of paths
267##########################################################################
268
269sub get_sourcepath_from_filename_and_includepath
270{
271 my ($searchfilenameref, $includepatharrayref) = @_;
272
273 my $onefile = "";
274 my $foundsourcefile = 0;
261 }
262
263}
264
265##########################################################################
266# Searching a file in a list of paths
267##########################################################################
268
269sub get_sourcepath_from_filename_and_includepath
270{
271 my ($searchfilenameref, $includepatharrayref) = @_;
272
273 my $onefile = "";
274 my $foundsourcefile = 0;
275
275
276 for ( my $j = 0; $j <= $#{$includepatharrayref}; $j++ )
277 {
278 my $includepath = ${$includepatharrayref}[$j];
279 $includepath =~ s/^\s*//;
280 $includepath =~ s/\s*$//;
281
282 $onefile = $includepath . $separator . $$searchfilenameref;
283
284 if ( -f $onefile )
285 {
286 $foundsourcefile = 1;
287 last;
288 }
289 }
290
291 if (!($foundsourcefile)) { $onefile = ""; }
276 for ( my $j = 0; $j <= $#{$includepatharrayref}; $j++ )
277 {
278 my $includepath = ${$includepatharrayref}[$j];
279 $includepath =~ s/^\s*//;
280 $includepath =~ s/\s*$//;
281
282 $onefile = $includepath . $separator . $$searchfilenameref;
283
284 if ( -f $onefile )
285 {
286 $foundsourcefile = 1;
287 last;
288 }
289 }
290
291 if (!($foundsourcefile)) { $onefile = ""; }
292
292
293 return \$onefile;
294}
295
296##############################################################
297# Removing all empty directories below a specified directory
298##############################################################
299
300sub remove_empty_dirs_in_folder
301{
302 my ( $dir, $firstrun ) = @_;
303
304 if ( $firstrun )
305 {
306 print "Removing superfluous directories\n";
307 }
308
309 my @content = ();
293 return \$onefile;
294}
295
296##############################################################
297# Removing all empty directories below a specified directory
298##############################################################
299
300sub remove_empty_dirs_in_folder
301{
302 my ( $dir, $firstrun ) = @_;
303
304 if ( $firstrun )
305 {
306 print "Removing superfluous directories\n";
307 }
308
309 my @content = ();
310
310
311 $dir =~ s/\Q$separator\E\s*$//;
312
313 if ( -d $dir )
314 {
315 opendir(DIR, $dir);
316 @content = readdir(DIR);
317 closedir(DIR);
318
319 my $oneitem;
311 $dir =~ s/\Q$separator\E\s*$//;
312
313 if ( -d $dir )
314 {
315 opendir(DIR, $dir);
316 @content = readdir(DIR);
317 closedir(DIR);
318
319 my $oneitem;
320
320
321 foreach $oneitem (@content)
322 {
323 if ((!($oneitem eq ".")) && (!($oneitem eq "..")))
324 {
325 my $item = $dir . $separator . $oneitem;
326
327 if ( -d $item ) # recursive
328 {
329 remove_empty_dirs_in_folder($item, 0);
330 }
331 }
332 }
321 foreach $oneitem (@content)
322 {
323 if ((!($oneitem eq ".")) && (!($oneitem eq "..")))
324 {
325 my $item = $dir . $separator . $oneitem;
326
327 if ( -d $item ) # recursive
328 {
329 remove_empty_dirs_in_folder($item, 0);
330 }
331 }
332 }
333
334 # try to remove empty directory
333
334 # try to remove empty directory
335 my $returnvalue = rmdir $dir;
336
335 my $returnvalue = rmdir $dir;
336
337 # if ( $returnvalue ) { print "Successfully removed empty dir $dir\n"; }
337 # if ( $returnvalue ) { print "Successfully removed empty dir $dir\n"; }
338 }
339}
340
341####################################################
342# Detecting the directory with extensions
343####################################################
344
345sub get_extensions_dir
346{
347 my ( $unopkgfile ) = @_;
338 }
339}
340
341####################################################
342# Detecting the directory with extensions
343####################################################
344
345sub get_extensions_dir
346{
347 my ( $unopkgfile ) = @_;
348
348
349 my $localbranddir = $unopkgfile;
350 get_path_from_fullqualifiedname(\$localbranddir); # "program" dir in brand layer
351 get_path_from_fullqualifiedname(\$localbranddir); # root dir in brand layer
352 $localbranddir =~ s/\Q$separator\E\s*$//;
353 my $extensiondir = $localbranddir . $separator . "share" . $separator . "extensions";
354 my $preregdir = $localbranddir . $separator . "share" . $separator . "prereg" . $separator . "bundled";
349 my $localbranddir = $unopkgfile;
350 get_path_from_fullqualifiedname(\$localbranddir); # "program" dir in brand layer
351 get_path_from_fullqualifiedname(\$localbranddir); # root dir in brand layer
352 $localbranddir =~ s/\Q$separator\E\s*$//;
353 my $extensiondir = $localbranddir . $separator . "share" . $separator . "extensions";
354 my $preregdir = $localbranddir . $separator . "share" . $separator . "prereg" . $separator . "bundled";
355
356 return ($extensiondir, $preregdir);
355
356 return ($extensiondir, $preregdir);
357}
358
359########################################################
360# Finding all files with a specified file extension
361# in a specified directory.
362########################################################
363
364sub find_file_with_file_extension
365{
366 my ($extension, $dir) = @_;
357}
358
359########################################################
360# Finding all files with a specified file extension
361# in a specified directory.
362########################################################
363
364sub find_file_with_file_extension
365{
366 my ($extension, $dir) = @_;
367
367
368 my @allfiles = ();
369 my @sourcefiles = ();
370
371 $dir =~ s/\Q$separator\E\s*$//;
372
373 opendir(DIR, $dir);
374 @sourcefiles = readdir(DIR);
375 closedir(DIR);
376
377 my $onefile;
368 my @allfiles = ();
369 my @sourcefiles = ();
370
371 $dir =~ s/\Q$separator\E\s*$//;
372
373 opendir(DIR, $dir);
374 @sourcefiles = readdir(DIR);
375 closedir(DIR);
376
377 my $onefile;
378
378
379 foreach $onefile (@sourcefiles)
380 {
381 if ((!($onefile eq ".")) && (!($onefile eq "..")))
382 {
383 if ( $onefile =~ /^\s*(\S.*?)\.$extension\s*$/ )
384 {
385 push(@allfiles, $onefile)
386 }
387 }
388 }
379 foreach $onefile (@sourcefiles)
380 {
381 if ((!($onefile eq ".")) && (!($onefile eq "..")))
382 {
383 if ( $onefile =~ /^\s*(\S.*?)\.$extension\s*$/ )
384 {
385 push(@allfiles, $onefile)
386 }
387 }
388 }
389
389
390 return \@allfiles;
391}
392
393##############################################################
394# Creating a directory with all parent directories
395##############################################################
396
397sub create_directories
398{
399 my ($directory) = @_;
400
401 if ( ! try_to_create_directory($directory) )
402 {
403 my $parentdir = $directory;
404 get_path_from_fullqualifiedname(\$parentdir);
405 create_directories($parentdir); # recursive
406 }
390 return \@allfiles;
391}
392
393##############################################################
394# Creating a directory with all parent directories
395##############################################################
396
397sub create_directories
398{
399 my ($directory) = @_;
400
401 if ( ! try_to_create_directory($directory) )
402 {
403 my $parentdir = $directory;
404 get_path_from_fullqualifiedname(\$parentdir);
405 create_directories($parentdir); # recursive
406 }
407
407
408 create_directory($directory); # now it has to succeed
409}
410
411##############################################################
412# Creating one directory
413##############################################################
414
415sub create_directory

--- 5 unchanged lines hidden (view full) ---

421
422##############################################################
423# Trying to create a directory, no error if this fails
424##############################################################
425
426sub try_to_create_directory
427{
428 my ($directory) = @_;
408 create_directory($directory); # now it has to succeed
409}
410
411##############################################################
412# Creating one directory
413##############################################################
414
415sub create_directory

--- 5 unchanged lines hidden (view full) ---

421
422##############################################################
423# Trying to create a directory, no error if this fails
424##############################################################
425
426sub try_to_create_directory
427{
428 my ($directory) = @_;
429
429
430 my $returnvalue = 1;
431 my $created_directory = 0;
432
433 if (!(-d $directory))
434 {
435 $returnvalue = mkdir($directory, 0775);
436
437 if ($returnvalue)
438 {
439 $created_directory = 1;
430 my $returnvalue = 1;
431 my $created_directory = 0;
432
433 if (!(-d $directory))
434 {
435 $returnvalue = mkdir($directory, 0775);
436
437 if ($returnvalue)
438 {
439 $created_directory = 1;
440
441 my $localcall = "chmod 775 $directory \>\/dev\/null 2\>\&1";
442 system($localcall);
440
441 my $localcall = "chmod 775 $directory \>\/dev\/null 2\>\&1";
442 system($localcall);
443 }
444 else
445 {
446 $created_directory = 0;
447 }
448 }
449 else
450 {

--- 7 unchanged lines hidden (view full) ---

458# Getting path from full file name
459###########################################
460
461sub get_path_from_fullqualifiedname
462{
463 my ($longfilenameref) = @_;
464
465 if ( $$longfilenameref =~ /\Q$separator\E/ ) # Is there a separator in the path? Otherwise the path is empty.
443 }
444 else
445 {
446 $created_directory = 0;
447 }
448 }
449 else
450 {

--- 7 unchanged lines hidden (view full) ---

458# Getting path from full file name
459###########################################
460
461sub get_path_from_fullqualifiedname
462{
463 my ($longfilenameref) = @_;
464
465 if ( $$longfilenameref =~ /\Q$separator\E/ ) # Is there a separator in the path? Otherwise the path is empty.
466 {
466 {
467 if ( $$longfilenameref =~ /^\s*(\S.*\Q$separator\E)(\S.+\S?)/ )
468 {
469 $$longfilenameref = $1;
470 }
471 }
472 else
473 {
474 $$longfilenameref = ""; # there is no path
467 if ( $$longfilenameref =~ /^\s*(\S.*\Q$separator\E)(\S.+\S?)/ )
468 {
469 $$longfilenameref = $1;
470 }
471 }
472 else
473 {
474 $$longfilenameref = ""; # there is no path
475 }
475 }
476}
477
478##############################################################
479# Getting file name from full file name
480##############################################################
481
482sub make_absolute_filename_to_relative_filename
483{
484 my ($longfilenameref) = @_;
476}
477
478##############################################################
479# Getting file name from full file name
480##############################################################
481
482sub make_absolute_filename_to_relative_filename
483{
484 my ($longfilenameref) = @_;
485
485
486 # Either '/' or '\'.
487 if ( $$longfilenameref =~ /^.*[\/\\](\S.+\S?)/ )
488 {
489 $$longfilenameref = $1;
490 }
491}
492
493############################################

--- 5 unchanged lines hidden (view full) ---

499{
500 my ($message) = @_;
501
502 print "\n***************************************************************\n";
503 print "$message\n";
504 print "***************************************************************\n";
505 remove_complete_directory($savetemppath, 1);
506 print "\n" . get_time_string();
486 # Either '/' or '\'.
487 if ( $$longfilenameref =~ /^.*[\/\\](\S.+\S?)/ )
488 {
489 $$longfilenameref = $1;
490 }
491}
492
493############################################

--- 5 unchanged lines hidden (view full) ---

499{
500 my ($message) = @_;
501
502 print "\n***************************************************************\n";
503 print "$message\n";
504 print "***************************************************************\n";
505 remove_complete_directory($savetemppath, 1);
506 print "\n" . get_time_string();
507 exit(-1);
507 exit(-1);
508}
509
510#################################################################################
511# Unpacking cabinet files with expand
512#################################################################################
513
514sub unpack_cabinet_file
515{
516 my ($cabfilename, $unpackdir) = @_;
508}
509
510#################################################################################
511# Unpacking cabinet files with expand
512#################################################################################
513
514sub unpack_cabinet_file
515{
516 my ($cabfilename, $unpackdir) = @_;
517
517
518 my $expandfile = "expand.exe"; # has to be in the PATH
518 my $expandfile = "expand.exe"; # has to be in the PATH
519
519
520 # expand.exe has to be located in the system directory.
520 # expand.exe has to be located in the system directory.
521 # Cygwin has another tool expand.exe, that converts tabs to spaces. This cannot be used of course.
522 # But this wrong expand.exe is typically in the PATH before this expand.exe, to unpack
521 # Cygwin has another tool expand.exe, that converts tabs to spaces. This cannot be used of course.
522 # But this wrong expand.exe is typically in the PATH before this expand.exe, to unpack
523 # cabinet files.
524
525 if ( $^O =~ /cygwin/i )
526 {
527 $expandfile = $ENV{'SYSTEMROOT'} . "/system32/expand.exe"; # Has to be located in the systemdirectory
528 $expandfile =~ s/\\/\//;
529 if ( ! -f $expandfile ) { exit_program("ERROR: Did not find file $expandfile in the Windows system folder!"); }
530 }
523 # cabinet files.
524
525 if ( $^O =~ /cygwin/i )
526 {
527 $expandfile = $ENV{'SYSTEMROOT'} . "/system32/expand.exe"; # Has to be located in the systemdirectory
528 $expandfile =~ s/\\/\//;
529 if ( ! -f $expandfile ) { exit_program("ERROR: Did not find file $expandfile in the Windows system folder!"); }
530 }
531
531
532 my $expandlogfile = $unpackdir . $separator . "expand.log";
533
534 # exclude cabinet file
535 # my $systemcall = $cabarc . " -o X " . $mergemodulehash->{'cabinetfile'};
536
537 my $systemcall = "";
538 if ( $^O =~ /cygwin/i ) {
539 my $localunpackdir = qx{cygpath -w "$unpackdir"};

--- 25 unchanged lines hidden (view full) ---

565
566 my $msidb = "msidb.exe"; # Has to be in the path
567 if ( $localmsidbpath ) { $msidb = $localmsidbpath; }
568 my $infoline = "";
569 my $systemcall = "";
570 my $returnvalue = "";
571
572 if ( $^O =~ /cygwin/i ) {
532 my $expandlogfile = $unpackdir . $separator . "expand.log";
533
534 # exclude cabinet file
535 # my $systemcall = $cabarc . " -o X " . $mergemodulehash->{'cabinetfile'};
536
537 my $systemcall = "";
538 if ( $^O =~ /cygwin/i ) {
539 my $localunpackdir = qx{cygpath -w "$unpackdir"};

--- 25 unchanged lines hidden (view full) ---

565
566 my $msidb = "msidb.exe"; # Has to be in the path
567 if ( $localmsidbpath ) { $msidb = $localmsidbpath; }
568 my $infoline = "";
569 my $systemcall = "";
570 my $returnvalue = "";
571
572 if ( $^O =~ /cygwin/i ) {
573 chomp( $fullmsidatabasepath = qx{cygpath -w "$fullmsidatabasepath"} );
573 chomp( $fullmsidatabasepath = qx{cygpath -w "$fullmsidatabasepath"} );
574 # msidb.exe really wants backslashes. (And double escaping because system() expands the string.)
575 $fullmsidatabasepath =~ s/\\/\\\\/g;
576 $workdir =~ s/\\/\\\\/g;
577 # and if there are still slashes, they also need to be double backslash
578 $fullmsidatabasepath =~ s/\//\\\\/g;
579 $workdir =~ s/\//\\\\/g;
580 }
581
582 # Export of all tables by using "*"
574 # msidb.exe really wants backslashes. (And double escaping because system() expands the string.)
575 $fullmsidatabasepath =~ s/\\/\\\\/g;
576 $workdir =~ s/\\/\\\\/g;
577 # and if there are still slashes, they also need to be double backslash
578 $fullmsidatabasepath =~ s/\//\\\\/g;
579 $workdir =~ s/\//\\\\/g;
580 }
581
582 # Export of all tables by using "*"
583
583
584 $systemcall = $msidb . " -d " . $fullmsidatabasepath . " -f " . $workdir . " -e $tablelist";
585 print "\nAnalyzing msi database\n";
586 $returnvalue = system($systemcall);
587
588 if ($returnvalue)
589 {
590 $infoline = "ERROR: Could not execute $systemcall !\n";
591 exit_program($infoline);

--- 4 unchanged lines hidden (view full) ---

596# Check, if this installation set contains
597# internal cabinet files included into the msi
598# database.
599########################################################
600
601sub check_for_internal_cabfiles
602{
603 my ($cabfilehash) = @_;
584 $systemcall = $msidb . " -d " . $fullmsidatabasepath . " -f " . $workdir . " -e $tablelist";
585 print "\nAnalyzing msi database\n";
586 $returnvalue = system($systemcall);
587
588 if ($returnvalue)
589 {
590 $infoline = "ERROR: Could not execute $systemcall !\n";
591 exit_program($infoline);

--- 4 unchanged lines hidden (view full) ---

596# Check, if this installation set contains
597# internal cabinet files included into the msi
598# database.
599########################################################
600
601sub check_for_internal_cabfiles
602{
603 my ($cabfilehash) = @_;
604
604
605 my $contains_internal_cabfiles = 0;
606 my %allcabfileshash = ();
605 my $contains_internal_cabfiles = 0;
606 my %allcabfileshash = ();
607
607
608 foreach my $filename ( keys %{$cabfilehash} )
609 {
610 if ( $filename =~ /^\s*\#/ ) # starting with a hash
611 {
612 $contains_internal_cabfiles = 1;
613 # setting real filename without hash as key and name with hash as value
614 my $realfilename = $filename;
615 $realfilename =~ s/^\s*\#//;
616 $allcabfileshash{$realfilename} = $filename;
617 }
618 }
608 foreach my $filename ( keys %{$cabfilehash} )
609 {
610 if ( $filename =~ /^\s*\#/ ) # starting with a hash
611 {
612 $contains_internal_cabfiles = 1;
613 # setting real filename without hash as key and name with hash as value
614 my $realfilename = $filename;
615 $realfilename =~ s/^\s*\#//;
616 $allcabfileshash{$realfilename} = $filename;
617 }
618 }
619
619
620 return ( $contains_internal_cabfiles, \%allcabfileshash );
621}
622
623#################################################################
624# Exclude all cab files from the msi database.
625#################################################################
626
627sub extract_cabs_from_database
628{
629 my ($msidatabase, $allcabfiles) = @_;
630
631 my $infoline = "";
632 my $fullsuccess = 1;
633 my $msidb = "msidb.exe"; # Has to be in the path
634 if ( $localmsidbpath ) { $msidb = $localmsidbpath; }
620 return ( $contains_internal_cabfiles, \%allcabfileshash );
621}
622
623#################################################################
624# Exclude all cab files from the msi database.
625#################################################################
626
627sub extract_cabs_from_database
628{
629 my ($msidatabase, $allcabfiles) = @_;
630
631 my $infoline = "";
632 my $fullsuccess = 1;
633 my $msidb = "msidb.exe"; # Has to be in the path
634 if ( $localmsidbpath ) { $msidb = $localmsidbpath; }
635
635
636 my @all_excluded_cabfiles = ();
637
638 if( $^O =~ /cygwin/i )
639 {
640 $msidatabase = qx{cygpath -w "$msidatabase"};
641 $msidatabase =~ s/\\/\\\\/g;
642 $msidatabase =~ s/\s*$//g;
643 }
644 else
645 {
646 # msidb.exe really wants backslashes. (And double escaping because system() expands the string.)
647 $msidatabase =~ s/\//\\\\/g;
648 }
649
650 foreach my $onefile ( keys %{$allcabfiles} )
651 {
652 my $systemcall = $msidb . " -d " . $msidatabase . " -x " . $onefile;
636 my @all_excluded_cabfiles = ();
637
638 if( $^O =~ /cygwin/i )
639 {
640 $msidatabase = qx{cygpath -w "$msidatabase"};
641 $msidatabase =~ s/\\/\\\\/g;
642 $msidatabase =~ s/\s*$//g;
643 }
644 else
645 {
646 # msidb.exe really wants backslashes. (And double escaping because system() expands the string.)
647 $msidatabase =~ s/\//\\\\/g;
648 }
649
650 foreach my $onefile ( keys %{$allcabfiles} )
651 {
652 my $systemcall = $msidb . " -d " . $msidatabase . " -x " . $onefile;
653 system($systemcall);
653 system($systemcall);
654 push(@all_excluded_cabfiles, $onefile);
655 }
654 push(@all_excluded_cabfiles, $onefile);
655 }
656
656
657 \@all_excluded_cabfiles;
658}
659
660################################################################################
661# Collect all DiskIds to the corresponding cabinet files from Media.idt.
662################################################################################
663
664sub analyze_media_file
665{
666 my ($filecontent) = @_;
657 \@all_excluded_cabfiles;
658}
659
660################################################################################
661# Collect all DiskIds to the corresponding cabinet files from Media.idt.
662################################################################################
663
664sub analyze_media_file
665{
666 my ($filecontent) = @_;
667
667
668 my %diskidhash = ();
669
670 for ( my $i = 0; $i <= $#{$filecontent}; $i++ )
671 {
672 if ( $i < 3 ) { next; }
673
674 if ( ${$filecontent}[$i] =~ /^\s*(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\s*$/ )
675 {

--- 7 unchanged lines hidden (view full) ---

683 return \%diskidhash;
684}
685
686sub analyze_customaction_file
687{
688 my ($filecontent) = @_;
689
690 my $register_extensions_exists = 0;
668 my %diskidhash = ();
669
670 for ( my $i = 0; $i <= $#{$filecontent}; $i++ )
671 {
672 if ( $i < 3 ) { next; }
673
674 if ( ${$filecontent}[$i] =~ /^\s*(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\s*$/ )
675 {

--- 7 unchanged lines hidden (view full) ---

683 return \%diskidhash;
684}
685
686sub analyze_customaction_file
687{
688 my ($filecontent) = @_;
689
690 my $register_extensions_exists = 0;
691
691
692 my %table = ();
693
694 for ( my $i = 0; $i <= $#{$filecontent}; $i++ )
695 {
696 if ( ${$filecontent}[$i] =~ /^\s*RegisterExtensions\s+/ )
692 my %table = ();
693
694 for ( my $i = 0; $i <= $#{$filecontent}; $i++ )
695 {
696 if ( ${$filecontent}[$i] =~ /^\s*RegisterExtensions\s+/ )
697 {
697 {
698 $register_extensions_exists = 1;
699 last;
700 }
701 }
702
703 return $register_extensions_exists;
704}
705
706################################################################################
707# Analyzing the content of Directory.idt
708#################################################################################
709
710sub analyze_directory_file
711{
712 my ($filecontent) = @_;
698 $register_extensions_exists = 1;
699 last;
700 }
701 }
702
703 return $register_extensions_exists;
704}
705
706################################################################################
707# Analyzing the content of Directory.idt
708#################################################################################
709
710sub analyze_directory_file
711{
712 my ($filecontent) = @_;
713
713
714 my %table = ();
715
716 for ( my $i = 0; $i <= $#{$filecontent}; $i++ )
717 {
718 if (( $i == 0 ) || ( $i == 1 ) || ( $i == 2 )) { next; }
719
720 if ( ${$filecontent}[$i] =~ /^\s*(.*?)\t(.*?)\t(.*?)\s*$/ )
721 {
722 my $dir = $1;
723 my $parent = $2;
724 my $name = $3;
714 my %table = ();
715
716 for ( my $i = 0; $i <= $#{$filecontent}; $i++ )
717 {
718 if (( $i == 0 ) || ( $i == 1 ) || ( $i == 2 )) { next; }
719
720 if ( ${$filecontent}[$i] =~ /^\s*(.*?)\t(.*?)\t(.*?)\s*$/ )
721 {
722 my $dir = $1;
723 my $parent = $2;
724 my $name = $3;
725
725
726 if ( $name =~ /^\s*(.*?)\s*\:\s*(.*?)\s*$/ ) { $name = $2; }
727 if ( $name =~ /^\s*(.*?)\s*\|\s*(.*?)\s*$/ ) { $name = $2; }
726 if ( $name =~ /^\s*(.*?)\s*\:\s*(.*?)\s*$/ ) { $name = $2; }
727 if ( $name =~ /^\s*(.*?)\s*\|\s*(.*?)\s*$/ ) { $name = $2; }
728
728
729 my %helphash = ();
730 $helphash{'Directory_Parent'} = $parent;
731 $helphash{'DefaultDir'} = $name;
732 $table{$dir} = \%helphash;
733 }
734 }
729 my %helphash = ();
730 $helphash{'Directory_Parent'} = $parent;
731 $helphash{'DefaultDir'} = $name;
732 $table{$dir} = \%helphash;
733 }
734 }
735
736 return \%table;
735
736 return \%table;
737}
738
739#################################################################################
740# Analyzing the content of Component.idt
741#################################################################################
742
743sub analyze_component_file
744{
745 my ($filecontent) = @_;
737}
738
739#################################################################################
740# Analyzing the content of Component.idt
741#################################################################################
742
743sub analyze_component_file
744{
745 my ($filecontent) = @_;
746
746
747 my %table = ();
747 my %table = ();
748
748
749 for ( my $i = 0; $i <= $#{$filecontent}; $i++ )
750 {
751 if (( $i == 0 ) || ( $i == 1 ) || ( $i == 2 )) { next; }
752
753 if ( ${$filecontent}[$i] =~ /^\s*(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\s*$/ )
754 {
755 my $component = $1;
756 my $dir = $3;
749 for ( my $i = 0; $i <= $#{$filecontent}; $i++ )
750 {
751 if (( $i == 0 ) || ( $i == 1 ) || ( $i == 2 )) { next; }
752
753 if ( ${$filecontent}[$i] =~ /^\s*(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\s*$/ )
754 {
755 my $component = $1;
756 my $dir = $3;
757
757
758 $table{$component} = $dir;
759 }
760 }
761
758 $table{$component} = $dir;
759 }
760 }
761
762 return \%table;
762 return \%table;
763}
764
765#################################################################################
766# Analyzing the content of File.idt
767#################################################################################
768
769sub analyze_file_file
770{
771 my ($filecontent) = @_;
763}
764
765#################################################################################
766# Analyzing the content of File.idt
767#################################################################################
768
769sub analyze_file_file
770{
771 my ($filecontent) = @_;
772
772
773 my %table = ();
774 my %fileorder = ();
775 my $maxsequence = 0;
773 my %table = ();
774 my %fileorder = ();
775 my $maxsequence = 0;
776
776
777 for ( my $i = 0; $i <= $#{$filecontent}; $i++ )
778 {
779 if (( $i == 0 ) || ( $i == 1 ) || ( $i == 2 )) { next; }
780
781 if ( ${$filecontent}[$i] =~ /^\s*(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\s*$/ )
782 {
783 my $file = $1;
784 my $comp = $2;
785 my $filename = $3;
786 my $sequence = $8;
787
788 if ( $filename =~ /^\s*(.*?)\s*\|\s*(.*?)\s*$/ ) { $filename = $2; }
777 for ( my $i = 0; $i <= $#{$filecontent}; $i++ )
778 {
779 if (( $i == 0 ) || ( $i == 1 ) || ( $i == 2 )) { next; }
780
781 if ( ${$filecontent}[$i] =~ /^\s*(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\t(.*?)\s*$/ )
782 {
783 my $file = $1;
784 my $comp = $2;
785 my $filename = $3;
786 my $sequence = $8;
787
788 if ( $filename =~ /^\s*(.*?)\s*\|\s*(.*?)\s*$/ ) { $filename = $2; }
789
789
790 my %helphash = ();
791 $helphash{'Component'} = $comp;
792 $helphash{'FileName'} = $filename;
793 $helphash{'Sequence'} = $sequence;
794
795 $table{$file} = \%helphash;
790 my %helphash = ();
791 $helphash{'Component'} = $comp;
792 $helphash{'FileName'} = $filename;
793 $helphash{'Sequence'} = $sequence;
794
795 $table{$file} = \%helphash;
796
796
797 $fileorder{$sequence} = $file;
797 $fileorder{$sequence} = $file;
798
798
799 if ( $sequence > $maxsequence ) { $maxsequence = $sequence; }
800 }
801 }
802
803 return (\%table, \%fileorder, $maxsequence);
804}
805
806####################################################################################
807# Recursively creating the directory tree
808####################################################################################
809
810sub create_directory_tree
811{
799 if ( $sequence > $maxsequence ) { $maxsequence = $sequence; }
800 }
801 }
802
803 return (\%table, \%fileorder, $maxsequence);
804}
805
806####################################################################################
807# Recursively creating the directory tree
808####################################################################################
809
810sub create_directory_tree
811{
812 my ($parent, $pathcollector, $fulldir, $dirhash) = @_;
812 my ($parent, $pathcollector, $fulldir, $dirhash) = @_;
813
814 foreach my $dir ( keys %{$dirhash} )
815 {
816 if (( $dirhash->{$dir}->{'Directory_Parent'} eq $parent ) && ( $dirhash->{$dir}->{'DefaultDir'} ne "." ))
817 {
818 my $dirname = $dirhash->{$dir}->{'DefaultDir'};
819 # Create the directory
820 my $newdir = $fulldir . $separator . $dirname;

--- 10 unchanged lines hidden (view full) ---

831# Creating the directory tree
832####################################################################################
833
834sub create_directory_structure
835{
836 my ($dirhash, $targetdir) = @_;
837
838 print "Creating directories\n";
813
814 foreach my $dir ( keys %{$dirhash} )
815 {
816 if (( $dirhash->{$dir}->{'Directory_Parent'} eq $parent ) && ( $dirhash->{$dir}->{'DefaultDir'} ne "." ))
817 {
818 my $dirname = $dirhash->{$dir}->{'DefaultDir'};
819 # Create the directory
820 my $newdir = $fulldir . $separator . $dirname;

--- 10 unchanged lines hidden (view full) ---

831# Creating the directory tree
832####################################################################################
833
834sub create_directory_structure
835{
836 my ($dirhash, $targetdir) = @_;
837
838 print "Creating directories\n";
839
839
840 my %fullpathhash = ();
840 my %fullpathhash = ();
841
841
842 my @startparents = ("TARGETDIR", "INSTALLLOCATION");
842 my @startparents = ("TARGETDIR", "INSTALLLOCATION");
843
843
844 foreach $dir (@startparents) { create_directory_tree($dir, \%fullpathhash, $targetdir, $dirhash); }
845
846 # Also adding the paths of the startparents
847 foreach $dir (@startparents)
848 {
849 if ( ! exists($fullpathhash{$dir}) ) { $fullpathhash{$dir} = $targetdir; }
850 }
844 foreach $dir (@startparents) { create_directory_tree($dir, \%fullpathhash, $targetdir, $dirhash); }
845
846 # Also adding the paths of the startparents
847 foreach $dir (@startparents)
848 {
849 if ( ! exists($fullpathhash{$dir}) ) { $fullpathhash{$dir} = $targetdir; }
850 }
851
851
852 return \%fullpathhash;
853}
854
855####################################################################################
856# Cygwin: Setting privileges for files
857####################################################################################
858
859sub change_privileges
860{
861 my ($destfile, $privileges) = @_;
852 return \%fullpathhash;
853}
854
855####################################################################################
856# Cygwin: Setting privileges for files
857####################################################################################
858
859sub change_privileges
860{
861 my ($destfile, $privileges) = @_;
862
862
863 my $localcall = "chmod $privileges " . "\"" . $destfile . "\"";
864 system($localcall);
865}
866
867####################################################################################
868# Cygwin: Setting privileges for files recursively
869####################################################################################
870

--- 9 unchanged lines hidden (view full) ---

880
881######################################################
882# Creating a new directory with defined privileges
883######################################################
884
885sub create_directory_with_privileges
886{
887 my ($directory, $privileges) = @_;
863 my $localcall = "chmod $privileges " . "\"" . $destfile . "\"";
864 system($localcall);
865}
866
867####################################################################################
868# Cygwin: Setting privileges for files recursively
869####################################################################################
870

--- 9 unchanged lines hidden (view full) ---

880
881######################################################
882# Creating a new directory with defined privileges
883######################################################
884
885sub create_directory_with_privileges
886{
887 my ($directory, $privileges) = @_;
888
888
889 my $returnvalue = 1;
890 my $infoline = "";
891
892 if (!(-d $directory))
893 {
894 my $localprivileges = oct("0".$privileges); # changes "777" to 0777
895 $returnvalue = mkdir($directory, $localprivileges);
896
897 if ($returnvalue)
889 my $returnvalue = 1;
890 my $infoline = "";
891
892 if (!(-d $directory))
893 {
894 my $localprivileges = oct("0".$privileges); # changes "777" to 0777
895 $returnvalue = mkdir($directory, $localprivileges);
896
897 if ($returnvalue)
898 {
899 my $localcall = "chmod $privileges $directory \>\/dev\/null 2\>\&1";
900 system($localcall);
898 {
899 my $localcall = "chmod $privileges $directory \>\/dev\/null 2\>\&1";
900 system($localcall);
901 }
902 }
903 else
904 {
901 }
902 }
903 else
904 {
905 my $localcall = "chmod $privileges $directory \>\/dev\/null 2\>\&1";
906 system($localcall);
905 my $localcall = "chmod $privileges $directory \>\/dev\/null 2\>\&1";
906 system($localcall);
907 }
908}
909
910######################################################
907 }
908}
909
910######################################################
911# Creating a unique directory with pid extension
911# Creating a unique directory with pid extension
912######################################################
913
914sub create_pid_directory
915{
916 my ($directory) = @_;
912######################################################
913
914sub create_pid_directory
915{
916 my ($directory) = @_;
917
917
918 $directory =~ s/\Q$separator\E\s*$//;
919 my $pid = $$; # process id
920 my $time = time(); # time
918 $directory =~ s/\Q$separator\E\s*$//;
919 my $pid = $$; # process id
920 my $time = time(); # time
921
921
922 $directory = $directory . "_" . $pid . $time;
923
922 $directory = $directory . "_" . $pid . $time;
923
924 if ( ! -d $directory ) { create_directory($directory); }
924 if ( ! -d $directory ) { create_directory($directory); }
925 else { exit_program("ERROR: Directory $directory already exists!"); }
925 else { exit_program("ERROR: Directory $directory already exists!"); }
926
926
927 return $directory;
928}
929
930####################################################################################
931# Copying files into installation set
932####################################################################################
933
934sub copy_files_into_directory_structure
935{
936 my ($fileorder, $filehash, $componenthash, $fullpathhash, $maxsequence, $unpackdir, $installdir, $dirhash) = @_;
937
938 print "Copying files\n";
939
940 my $unopkgfile = "";
927 return $directory;
928}
929
930####################################################################################
931# Copying files into installation set
932####################################################################################
933
934sub copy_files_into_directory_structure
935{
936 my ($fileorder, $filehash, $componenthash, $fullpathhash, $maxsequence, $unpackdir, $installdir, $dirhash) = @_;
937
938 print "Copying files\n";
939
940 my $unopkgfile = "";
941
941
942 for ( my $i = 1; $i <= $maxsequence; $i++ )
943 {
944 if ( exists($fileorder->{$i}) )
945 {
946 my $file = $fileorder->{$i};
947 if ( ! exists($filehash->{$file}->{'Component'}) ) { exit_program("ERROR: Did not find component for file: \"$file\"."); }
948 my $component = $filehash->{$file}->{'Component'};
949 if ( ! exists($componenthash->{$component}) ) { exit_program("ERROR: Did not find directory for component: \"$component\"."); }
950 my $dirname = $componenthash->{$component};
951 if ( ! exists($fullpathhash->{$dirname}) ) { exit_program("ERROR: Did not find full directory path for dir: \"$dirname\"."); }
952 my $destdir = $fullpathhash->{$dirname};
953 if ( ! exists($filehash->{$file}->{'FileName'}) ) { exit_program("ERROR: Did not find \"FileName\" for file: \"$file\"."); }
954 my $destfile = $filehash->{$file}->{'FileName'};
955
956 $destfile = $destdir . $separator . $destfile;
957 my $sourcefile = $unpackdir . $separator . $file;
942 for ( my $i = 1; $i <= $maxsequence; $i++ )
943 {
944 if ( exists($fileorder->{$i}) )
945 {
946 my $file = $fileorder->{$i};
947 if ( ! exists($filehash->{$file}->{'Component'}) ) { exit_program("ERROR: Did not find component for file: \"$file\"."); }
948 my $component = $filehash->{$file}->{'Component'};
949 if ( ! exists($componenthash->{$component}) ) { exit_program("ERROR: Did not find directory for component: \"$component\"."); }
950 my $dirname = $componenthash->{$component};
951 if ( ! exists($fullpathhash->{$dirname}) ) { exit_program("ERROR: Did not find full directory path for dir: \"$dirname\"."); }
952 my $destdir = $fullpathhash->{$dirname};
953 if ( ! exists($filehash->{$file}->{'FileName'}) ) { exit_program("ERROR: Did not find \"FileName\" for file: \"$file\"."); }
954 my $destfile = $filehash->{$file}->{'FileName'};
955
956 $destfile = $destdir . $separator . $destfile;
957 my $sourcefile = $unpackdir . $separator . $file;
958
958
959 if ( ! -f $sourcefile )
960 {
961 # It is possible, that this was an unpacked file
962 # Looking in the dirhash, to find the subdirectory in the installation set (the id is $dirname)
963 # subdir is not recursively analyzed, only one directory.
959 if ( ! -f $sourcefile )
960 {
961 # It is possible, that this was an unpacked file
962 # Looking in the dirhash, to find the subdirectory in the installation set (the id is $dirname)
963 # subdir is not recursively analyzed, only one directory.
964
965 my $oldsourcefile = $sourcefile;
964
965 my $oldsourcefile = $sourcefile;
966 my $subdir = "";
967 if ( exists($dirhash->{$dirname}->{'DefaultDir'}) ) { $subdir = $dirhash->{$dirname}->{'DefaultDir'} . $separator; }
968 my $realfilename = $filehash->{$file}->{'FileName'};
969 my $localinstalldir = $installdir;
966 my $subdir = "";
967 if ( exists($dirhash->{$dirname}->{'DefaultDir'}) ) { $subdir = $dirhash->{$dirname}->{'DefaultDir'} . $separator; }
968 my $realfilename = $filehash->{$file}->{'FileName'};
969 my $localinstalldir = $installdir;
970
970
971 $localinstalldir =~ s/\\\s*$//;
972 $localinstalldir =~ s/\/\s*$//;
971 $localinstalldir =~ s/\\\s*$//;
972 $localinstalldir =~ s/\/\s*$//;
973
973
974 $sourcefile = $localinstalldir . $separator . $subdir . $realfilename;
974 $sourcefile = $localinstalldir . $separator . $subdir . $realfilename;
975
975
976 if ( ! -f $sourcefile ) { exit_program("ERROR: File not found: \"$oldsourcefile\" (or \"$sourcefile\")."); }
977 }
978
979 my $copyreturn = copy($sourcefile, $destfile);
980
981 if ( ! $copyreturn) { exit_program("ERROR: Could not copy $source to $dest\n"); }
982
983 # Searching unopkg.exe
984 if ( $destfile =~ /unopkg\.exe\s*$/ ) { $unopkgfile = $destfile; }
985 # if (( $^O =~ /cygwin/i ) && ( $destfile =~ /\.exe\s*$/ )) { change_privileges($destfile, "775"); }
986 }
987 # else # allowing missing sequence numbers ?
988 # {
989 # exit_program("ERROR: No file assigned to sequence $i");
990 # }
991 }
976 if ( ! -f $sourcefile ) { exit_program("ERROR: File not found: \"$oldsourcefile\" (or \"$sourcefile\")."); }
977 }
978
979 my $copyreturn = copy($sourcefile, $destfile);
980
981 if ( ! $copyreturn) { exit_program("ERROR: Could not copy $source to $dest\n"); }
982
983 # Searching unopkg.exe
984 if ( $destfile =~ /unopkg\.exe\s*$/ ) { $unopkgfile = $destfile; }
985 # if (( $^O =~ /cygwin/i ) && ( $destfile =~ /\.exe\s*$/ )) { change_privileges($destfile, "775"); }
986 }
987 # else # allowing missing sequence numbers ?
988 # {
989 # exit_program("ERROR: No file assigned to sequence $i");
990 # }
991 }
992
992
993 return ($unopkgfile);
994}
995
996######################################################
997# Removing a complete directory with subdirectories
998######################################################
999
1000sub remove_complete_directory
1001{
1002 my ($directory, $start) = @_;
1003
1004 my @content = ();
1005 my $infoline = "";
993 return ($unopkgfile);
994}
995
996######################################################
997# Removing a complete directory with subdirectories
998######################################################
999
1000sub remove_complete_directory
1001{
1002 my ($directory, $start) = @_;
1003
1004 my @content = ();
1005 my $infoline = "";
1006
1006
1007 $directory =~ s/\Q$separator\E\s*$//;
1008
1009 if ( -d $directory )
1010 {
1011 if ( $start ) { print "Removing directory $directory\n"; }
1007 $directory =~ s/\Q$separator\E\s*$//;
1008
1009 if ( -d $directory )
1010 {
1011 if ( $start ) { print "Removing directory $directory\n"; }
1012
1012
1013 opendir(DIR, $directory);
1014 @content = readdir(DIR);
1015 closedir(DIR);
1016
1017 my $oneitem;
1013 opendir(DIR, $directory);
1014 @content = readdir(DIR);
1015 closedir(DIR);
1016
1017 my $oneitem;
1018
1018
1019 foreach $oneitem (@content)
1020 {
1021 if ((!($oneitem eq ".")) && (!($oneitem eq "..")))
1022 {
1023 my $item = $directory . $separator . $oneitem;
1024
1025 if ( -f $item || -l $item ) # deleting files or links
1026 {
1027 unlink($item);
1028 }
1029
1030 if ( -d $item ) # recursive
1031 {
1032 remove_complete_directory($item, 0);
1033 }
1034 }
1035 }
1019 foreach $oneitem (@content)
1020 {
1021 if ((!($oneitem eq ".")) && (!($oneitem eq "..")))
1022 {
1023 my $item = $directory . $separator . $oneitem;
1024
1025 if ( -f $item || -l $item ) # deleting files or links
1026 {
1027 unlink($item);
1028 }
1029
1030 if ( -d $item ) # recursive
1031 {
1032 remove_complete_directory($item, 0);
1033 }
1034 }
1035 }
1036
1036
1037 # try to remove empty directory
1038 my $returnvalue = rmdir $directory;
1039 if ( ! $returnvalue ) { print "Warning: Problem with removing empty dir $directory\n"; }
1037 # try to remove empty directory
1038 my $returnvalue = rmdir $directory;
1039 if ( ! $returnvalue ) { print "Warning: Problem with removing empty dir $directory\n"; }
1040 }
1040 }
1041}
1042
1043####################################################################################
1044# Defining a temporary path
1045####################################################################################
1046
1047sub get_temppath
1048{
1049 my $temppath = "";
1041}
1042
1043####################################################################################
1044# Defining a temporary path
1045####################################################################################
1046
1047sub get_temppath
1048{
1049 my $temppath = "";
1050
1050
1051 if (( $ENV{'TMP'} ) || ( $ENV{'TEMP'} ))
1052 {
1053 if ( $ENV{'TMP'} ) { $temppath = $ENV{'TMP'}; }
1054 elsif ( $ENV{'TEMP'} ) { $temppath = $ENV{'TEMP'}; }
1055
1056 $temppath =~ s/\Q$separator\E\s*$//; # removing ending slashes and backslashes
1057 $temppath = $temppath . $separator . $globaltempdirname;
1058 create_directory_with_privileges($temppath, "777");
1059
1060 my $dirsave = $temppath;
1061
1062 $temppath = $temppath . $separator . "a";
1063 $temppath = create_pid_directory($temppath);
1064
1065 if ( ! -d $temppath ) { exit_program("ERROR: Failed to create directory $temppath ! Possible reason: Wrong privileges in directory $dirsave."); }
1066
1067 if ( $^O =~ /cygwin/i )
1068 {
1069 $temppath =~ s/\\/\\\\/g;
1051 if (( $ENV{'TMP'} ) || ( $ENV{'TEMP'} ))
1052 {
1053 if ( $ENV{'TMP'} ) { $temppath = $ENV{'TMP'}; }
1054 elsif ( $ENV{'TEMP'} ) { $temppath = $ENV{'TEMP'}; }
1055
1056 $temppath =~ s/\Q$separator\E\s*$//; # removing ending slashes and backslashes
1057 $temppath = $temppath . $separator . $globaltempdirname;
1058 create_directory_with_privileges($temppath, "777");
1059
1060 my $dirsave = $temppath;
1061
1062 $temppath = $temppath . $separator . "a";
1063 $temppath = create_pid_directory($temppath);
1064
1065 if ( ! -d $temppath ) { exit_program("ERROR: Failed to create directory $temppath ! Possible reason: Wrong privileges in directory $dirsave."); }
1066
1067 if ( $^O =~ /cygwin/i )
1068 {
1069 $temppath =~ s/\\/\\\\/g;
1070 chomp( $temppath = qx{cygpath -w "$temppath"} );
1070 chomp( $temppath = qx{cygpath -w "$temppath"} );
1071 }
1072
1073 $savetemppath = $temppath;
1074 }
1075 else
1076 {
1077 exit_program("ERROR: Could not set temporary directory (TMP and TEMP not set!).");
1078 }
1071 }
1072
1073 $savetemppath = $temppath;
1074 }
1075 else
1076 {
1077 exit_program("ERROR: Could not set temporary directory (TMP and TEMP not set!).");
1078 }
1079
1079
1080 return $temppath;
1081}
1082
1083####################################################################################
1084# Registering extensions
1085####################################################################################
1086
1087sub register_extensions_sync
1088{
1089 my ($unopkgfile, $localtemppath, $preregdir) = @_;
1090
1091 if ( $preregdir eq "" )
1092 {
1093 my $logtext = "ERROR: Failed to determine \"prereg\" folder for extension registration! Please check your installation set.";
1094 print $logtext . "\n";
1080 return $temppath;
1081}
1082
1083####################################################################################
1084# Registering extensions
1085####################################################################################
1086
1087sub register_extensions_sync
1088{
1089 my ($unopkgfile, $localtemppath, $preregdir) = @_;
1090
1091 if ( $preregdir eq "" )
1092 {
1093 my $logtext = "ERROR: Failed to determine \"prereg\" folder for extension registration! Please check your installation set.";
1094 print $logtext . "\n";
1095 exit_program($logtext);
1095 exit_program($logtext);
1096 }
1097
1098 my $from = cwd();
1096 }
1097
1098 my $from = cwd();
1099
1099
1100 my $path = $unopkgfile;
1101 get_path_from_fullqualifiedname(\$path);
1102 $path =~ s/\\\s*$//;
1103 $path =~ s/\/\s*$//;
1104
1105 my $executable = $unopkgfile;
1106 make_absolute_filename_to_relative_filename(\$executable);
1107
1100 my $path = $unopkgfile;
1101 get_path_from_fullqualifiedname(\$path);
1102 $path =~ s/\\\s*$//;
1103 $path =~ s/\/\s*$//;
1104
1105 my $executable = $unopkgfile;
1106 make_absolute_filename_to_relative_filename(\$executable);
1107
1108 chdir($path);
1108 chdir($path);
1109
1110 if ( ! $path_displayed )
1111 {
1112 print "... current dir: $path ...\n";
1113 $path_displayed = 1;
1114 }
1115
1116 $localtemppath =~ s/\\/\//g;
1117
1118 if ( $^O =~ /cygwin/i ) {
1119 $executable = "./" . $executable;
1120 $preregdir = qx{cygpath -m "$preregdir"};
1121 chomp($preregdir);
1122 }
1123
1124 $preregdir =~ s/\/\s*$//g;
1109
1110 if ( ! $path_displayed )
1111 {
1112 print "... current dir: $path ...\n";
1113 $path_displayed = 1;
1114 }
1115
1116 $localtemppath =~ s/\\/\//g;
1117
1118 if ( $^O =~ /cygwin/i ) {
1119 $executable = "./" . $executable;
1120 $preregdir = qx{cygpath -m "$preregdir"};
1121 chomp($preregdir);
1122 }
1123
1124 $preregdir =~ s/\/\s*$//g;
1125
1125
1126 my $systemcall = $executable . " sync --verbose 2\>\&1 |";
1127
1128 print "... $systemcall\n";
1129
1130 my @unopkgoutput = ();
1131
1132 open (UNOPKG, $systemcall);
1133 while (<UNOPKG>) {push(@unopkgoutput, $_); }
1134 close (UNOPKG);
1135
1136 my $returnvalue = $?; # $? contains the return value of the systemcall
1137
1138 if ($returnvalue)
1139 {
1140 print "ERROR: Could not execute \"$systemcall\"!\nExitcode: '$returnvalue'\n";
1141 for ( my $j = 0; $j <= $#unopkgoutput; $j++ ) { print "$unopkgoutput[$j]"; }
1142 exit_program("ERROR: $systemcall failed!");
1143 }
1126 my $systemcall = $executable . " sync --verbose 2\>\&1 |";
1127
1128 print "... $systemcall\n";
1129
1130 my @unopkgoutput = ();
1131
1132 open (UNOPKG, $systemcall);
1133 while (<UNOPKG>) {push(@unopkgoutput, $_); }
1134 close (UNOPKG);
1135
1136 my $returnvalue = $?; # $? contains the return value of the systemcall
1137
1138 if ($returnvalue)
1139 {
1140 print "ERROR: Could not execute \"$systemcall\"!\nExitcode: '$returnvalue'\n";
1141 for ( my $j = 0; $j <= $#unopkgoutput; $j++ ) { print "$unopkgoutput[$j]"; }
1142 exit_program("ERROR: $systemcall failed!");
1143 }
1144
1144
1145 chdir($from);
1146}
1147
1148####################################################################################
1149# Registering all extensions located in /share/extension/install
1150####################################################################################
1151
1152sub register_extensions
1153{
1154 my ($unopkgfile, $temppath, $preregdir) = @_;
1145 chdir($from);
1146}
1147
1148####################################################################################
1149# Registering all extensions located in /share/extension/install
1150####################################################################################
1151
1152sub register_extensions
1153{
1154 my ($unopkgfile, $temppath, $preregdir) = @_;
1155
1156 print "Registering extensions:\n";
1157
1155
1156 print "Registering extensions:\n";
1157
1158 if (( ! -f $unopkgfile ) || ( $unopkgfile eq "" ))
1159 {
1160 print("WARNING: Could not find unopkg.exe (Language Pack?)!\n");
1161 }
1162 else
1163 {
1164 register_extensions_sync($unopkgfile, $temppath, $preregdir);
1165 remove_complete_directory($temppath, 1);

--- 21 unchanged lines hidden (view full) ---

1187 }
1188
1189 close( IN );
1190
1191 return \@localfile;
1192}
1193
1194###############################################################
1158 if (( ! -f $unopkgfile ) || ( $unopkgfile eq "" ))
1159 {
1160 print("WARNING: Could not find unopkg.exe (Language Pack?)!\n");
1161 }
1162 else
1163 {
1164 register_extensions_sync($unopkgfile, $temppath, $preregdir);
1165 remove_complete_directory($temppath, 1);

--- 21 unchanged lines hidden (view full) ---

1187 }
1188
1189 close( IN );
1190
1191 return \@localfile;
1192}
1193
1194###############################################################
1195# Setting the time string for the
1196# Summary Information stream in the
1195# Setting the time string for the
1196# Summary Information stream in the
1197# msi database of the admin installations.
1198###############################################################
1199
1200sub get_sis_time_string
1197# msi database of the admin installations.
1198###############################################################
1199
1200sub get_sis_time_string
1201{
1201{
1202 # Syntax: <yyyy/mm/dd hh:mm:ss>
1203 my $second = (localtime())[0];
1204 my $minute = (localtime())[1];
1205 my $hour = (localtime())[2];
1206 my $day = (localtime())[3];
1207 my $month = (localtime())[4];
1208 my $year = 1900 + (localtime())[5];
1202 # Syntax: <yyyy/mm/dd hh:mm:ss>
1203 my $second = (localtime())[0];
1204 my $minute = (localtime())[1];
1205 my $hour = (localtime())[2];
1206 my $day = (localtime())[3];
1207 my $month = (localtime())[4];
1208 my $year = 1900 + (localtime())[5];
1209 $month++;
1210
1209 $month++;
1210
1211 if ( $second < 10 ) { $second = "0" . $second; }
1212 if ( $minute < 10 ) { $minute = "0" . $minute; }
1213 if ( $hour < 10 ) { $hour = "0" . $hour; }
1214 if ( $day < 10 ) { $day = "0" . $day; }
1215 if ( $month < 10 ) { $month = "0" . $month; }
1211 if ( $second < 10 ) { $second = "0" . $second; }
1212 if ( $minute < 10 ) { $minute = "0" . $minute; }
1213 if ( $hour < 10 ) { $hour = "0" . $hour; }
1214 if ( $day < 10 ) { $day = "0" . $day; }
1215 if ( $month < 10 ) { $month = "0" . $month; }
1216
1216
1217 my $timestring = $year . "/" . $month . "/" . $day . " " . $hour . ":" . $minute . ":" . $second;
1217 my $timestring = $year . "/" . $month . "/" . $day . " " . $hour . ":" . $minute . ":" . $second;
1218
1218
1219 return $timestring;
1220}
1221
1222###############################################################
1219 return $timestring;
1220}
1221
1222###############################################################
1223# Writing content of administrative installations into
1224# Summary Information Stream of msi database.
1223# Writing content of administrative installations into
1224# Summary Information Stream of msi database.
1225# This is required for example for following
1226# patch processes using Windows Installer service.
1227###############################################################
1228
1229sub write_sis_info
1230{
1231 my ($msidatabase) = @_;
1232
1233 print "Setting SIS in msi database\n";
1225# This is required for example for following
1226# patch processes using Windows Installer service.
1227###############################################################
1228
1229sub write_sis_info
1230{
1231 my ($msidatabase) = @_;
1232
1233 print "Setting SIS in msi database\n";
1234
1234
1235 if ( ! -f $msidatabase ) { exit_program("ERROR: Cannot find file $msidatabase"); }
1236
1237 my $msiinfo = "msiinfo.exe"; # Has to be in the path
1238 my $infoline = "";
1239 my $systemcall = "";
1240 my $returnvalue = "";
1241
1242 # Required setting for administrative installations:
1243 # -w 4 (source files are unpacked), wordcount
1244 # -s <date of admin installation>, LastPrinted, Syntax: <yyyy/mm/dd hh:mm:ss>
1245 # -l <person_making_admin_installation>, LastSavedBy
1235 if ( ! -f $msidatabase ) { exit_program("ERROR: Cannot find file $msidatabase"); }
1236
1237 my $msiinfo = "msiinfo.exe"; # Has to be in the path
1238 my $infoline = "";
1239 my $systemcall = "";
1240 my $returnvalue = "";
1241
1242 # Required setting for administrative installations:
1243 # -w 4 (source files are unpacked), wordcount
1244 # -s <date of admin installation>, LastPrinted, Syntax: <yyyy/mm/dd hh:mm:ss>
1245 # -l <person_making_admin_installation>, LastSavedBy
1246
1246
1247 my $wordcount = 4; # Unpacked files
1248 my $lastprinted = get_sis_time_string();
1249 my $lastsavedby = "Installer";
1247 my $wordcount = 4; # Unpacked files
1248 my $lastprinted = get_sis_time_string();
1249 my $lastsavedby = "Installer";
1250
1250
1251 my $localmsidatabase = $msidatabase;
1251 my $localmsidatabase = $msidatabase;
1252
1252
1253 if( $^O =~ /cygwin/i )
1254 {
1255 $localmsidatabase = qx{cygpath -w "$localmsidatabase"};
1256 $localmsidatabase =~ s/\\/\\\\/g;
1257 $localmsidatabase =~ s/\s*$//g;
1258 }
1253 if( $^O =~ /cygwin/i )
1254 {
1255 $localmsidatabase = qx{cygpath -w "$localmsidatabase"};
1256 $localmsidatabase =~ s/\\/\\\\/g;
1257 $localmsidatabase =~ s/\s*$//g;
1258 }
1259
1259
1260 $systemcall = $msiinfo . " " . "\"" . $localmsidatabase . "\"" . " -w " . $wordcount . " -s " . "\"" . $lastprinted . "\"" . " -l $lastsavedby";
1261
1262 $returnvalue = system($systemcall);
1263
1264 if ($returnvalue)
1265 {
1266 $infoline = "ERROR: Could not execute $systemcall !\n";
1267 exit_program($infoline);
1260 $systemcall = $msiinfo . " " . "\"" . $localmsidatabase . "\"" . " -w " . $wordcount . " -s " . "\"" . $lastprinted . "\"" . " -l $lastsavedby";
1261
1262 $returnvalue = system($systemcall);
1263
1264 if ($returnvalue)
1265 {
1266 $infoline = "ERROR: Could not execute $systemcall !\n";
1267 exit_program($infoline);
1268 }
1268 }
1269}
1270
1271###############################################################
1272# Convert time string
1273###############################################################
1274
1275sub convert_timestring
1276{
1277 my ($secondstring) = @_;
1278
1279 my $timestring = "";
1269}
1270
1271###############################################################
1272# Convert time string
1273###############################################################
1274
1275sub convert_timestring
1276{
1277 my ($secondstring) = @_;
1278
1279 my $timestring = "";
1280
1280
1281 if ( $secondstring < 60 ) # less than a minute
1282 {
1283 if ( $secondstring < 10 ) { $secondstring = "0" . $secondstring; }
1281 if ( $secondstring < 60 ) # less than a minute
1282 {
1283 if ( $secondstring < 10 ) { $secondstring = "0" . $secondstring; }
1284 $timestring = "00\:$secondstring min\.";
1284 $timestring = "00\:$secondstring min\.";
1285 }
1286 elsif ( $secondstring < 3600 )
1287 {
1288 my $minutes = $secondstring / 60;
1289 my $seconds = $secondstring % 60;
1290 if ( $minutes =~ /(\d*)\.\d*/ ) { $minutes = $1; }
1291 if ( $minutes < 10 ) { $minutes = "0" . $minutes; }
1292 if ( $seconds < 10 ) { $seconds = "0" . $seconds; }

--- 5 unchanged lines hidden (view full) ---

1298 my $secondstring = $secondstring % 3600;
1299 my $minutes = $secondstring / 60;
1300 my $seconds = $secondstring % 60;
1301 if ( $hours =~ /(\d*)\.\d*/ ) { $hours = $1; }
1302 if ( $minutes =~ /(\d*)\.\d*/ ) { $minutes = $1; }
1303 if ( $hours < 10 ) { $hours = "0" . $hours; }
1304 if ( $minutes < 10 ) { $minutes = "0" . $minutes; }
1305 if ( $seconds < 10 ) { $seconds = "0" . $seconds; }
1285 }
1286 elsif ( $secondstring < 3600 )
1287 {
1288 my $minutes = $secondstring / 60;
1289 my $seconds = $secondstring % 60;
1290 if ( $minutes =~ /(\d*)\.\d*/ ) { $minutes = $1; }
1291 if ( $minutes < 10 ) { $minutes = "0" . $minutes; }
1292 if ( $seconds < 10 ) { $seconds = "0" . $seconds; }

--- 5 unchanged lines hidden (view full) ---

1298 my $secondstring = $secondstring % 3600;
1299 my $minutes = $secondstring / 60;
1300 my $seconds = $secondstring % 60;
1301 if ( $hours =~ /(\d*)\.\d*/ ) { $hours = $1; }
1302 if ( $minutes =~ /(\d*)\.\d*/ ) { $minutes = $1; }
1303 if ( $hours < 10 ) { $hours = "0" . $hours; }
1304 if ( $minutes < 10 ) { $minutes = "0" . $minutes; }
1305 if ( $seconds < 10 ) { $seconds = "0" . $seconds; }
1306 $timestring = "$hours\:$minutes\:$seconds hours";
1306 $timestring = "$hours\:$minutes\:$seconds hours";
1307 }
1307 }
1308
1308
1309 return $timestring;
1310}
1311
1312###############################################################
1313# Returning time string for logging
1314###############################################################
1315
1316sub get_time_string

--- 17 unchanged lines hidden (view full) ---

1334check_system_path();
1335my $temppath = get_temppath();
1336
1337print("\nmsi database: $databasepath\n");
1338print("Destination directory: $targetdir\n" );
1339
1340my $helperdir = $temppath . $separator . "installhelper";
1341create_directory($helperdir);
1309 return $timestring;
1310}
1311
1312###############################################################
1313# Returning time string for logging
1314###############################################################
1315
1316sub get_time_string

--- 17 unchanged lines hidden (view full) ---

1334check_system_path();
1335my $temppath = get_temppath();
1336
1337print("\nmsi database: $databasepath\n");
1338print("Destination directory: $targetdir\n" );
1339
1340my $helperdir = $temppath . $separator . "installhelper";
1341create_directory($helperdir);
1342
1342
1343# Get File.idt, Component.idt and Directory.idt from database
1343# Get File.idt, Component.idt and Directory.idt from database
1344
1344
1345my $tablelist = "File Directory Component Media CustomAction";
1346extract_tables_from_database($databasepath, $helperdir, $tablelist);
1347
1348# Set unpackdir
1349my $unpackdir = $helperdir . $separator . "unpack";
1350create_directory($unpackdir);
1351
1352# Reading media table to check for internal cabinet files
1353my $filename = $helperdir . $separator . "Media.idt";
1354if ( ! -f $filename ) { exit_program("ERROR: Could not find required file: $filename !"); }
1355my $filecontent = read_file($filename);
1356my $cabfilehash = analyze_media_file($filecontent);
1357
1345my $tablelist = "File Directory Component Media CustomAction";
1346extract_tables_from_database($databasepath, $helperdir, $tablelist);
1347
1348# Set unpackdir
1349my $unpackdir = $helperdir . $separator . "unpack";
1350create_directory($unpackdir);
1351
1352# Reading media table to check for internal cabinet files
1353my $filename = $helperdir . $separator . "Media.idt";
1354if ( ! -f $filename ) { exit_program("ERROR: Could not find required file: $filename !"); }
1355my $filecontent = read_file($filename);
1356my $cabfilehash = analyze_media_file($filecontent);
1357
1358# Check, if there are internal cab files
1358# Check, if there are internal cab files
1359my ( $contains_internal_cabfiles, $all_internal_cab_files) = check_for_internal_cabfiles($cabfilehash);
1360
1361if ( $contains_internal_cabfiles )
1362{
1363 # Set unpackdir
1364 my $cabdir = $helperdir . $separator . "internal_cabs";
1365 create_directory($cabdir);
1366 my $from = cwd();
1367 chdir($cabdir);
1368 # Exclude all cabinet files from database
1369 my $all_excluded_cabs = extract_cabs_from_database($databasepath, $all_internal_cab_files);
1370 print "Unpacking files from internal cabinet file(s)\n";
1371 foreach my $cabfile ( @{$all_excluded_cabs} ) { unpack_cabinet_file($cabfile, $unpackdir); }
1372 chdir($from);
1373}
1359my ( $contains_internal_cabfiles, $all_internal_cab_files) = check_for_internal_cabfiles($cabfilehash);
1360
1361if ( $contains_internal_cabfiles )
1362{
1363 # Set unpackdir
1364 my $cabdir = $helperdir . $separator . "internal_cabs";
1365 create_directory($cabdir);
1366 my $from = cwd();
1367 chdir($cabdir);
1368 # Exclude all cabinet files from database
1369 my $all_excluded_cabs = extract_cabs_from_database($databasepath, $all_internal_cab_files);
1370 print "Unpacking files from internal cabinet file(s)\n";
1371 foreach my $cabfile ( @{$all_excluded_cabs} ) { unpack_cabinet_file($cabfile, $unpackdir); }
1372 chdir($from);
1373}
1374
1374
1375# Unpack all cab files into $helperdir, cab files must be located next to msi database
1376my $installdir = $databasepath;
1377
1378get_path_from_fullqualifiedname(\$installdir);
1379
1380my $databasefilename = $databasepath;
1381make_absolute_filename_to_relative_filename(\$databasefilename);
1382
1383my $cabfiles = find_file_with_file_extension("cab", $installdir);
1375# Unpack all cab files into $helperdir, cab files must be located next to msi database
1376my $installdir = $databasepath;
1377
1378get_path_from_fullqualifiedname(\$installdir);
1379
1380my $databasefilename = $databasepath;
1381make_absolute_filename_to_relative_filename(\$databasefilename);
1382
1383my $cabfiles = find_file_with_file_extension("cab", $installdir);
1384
1384
1385if (( $#{$cabfiles} < 0 ) && ( ! $contains_internal_cabfiles )) { exit_program("ERROR: Did not find any cab file in directory $installdir"); }
1386
1387print "Unpacking files from cabinet file(s)\n";
1388for ( my $i = 0; $i <= $#{$cabfiles}; $i++ )
1389{
1390 my $cabfile = $installdir . $separator . ${$cabfiles}[$i];
1391 unpack_cabinet_file($cabfile, $unpackdir);
1392}
1385if (( $#{$cabfiles} < 0 ) && ( ! $contains_internal_cabfiles )) { exit_program("ERROR: Did not find any cab file in directory $installdir"); }
1386
1387print "Unpacking files from cabinet file(s)\n";
1388for ( my $i = 0; $i <= $#{$cabfiles}; $i++ )
1389{
1390 my $cabfile = $installdir . $separator . ${$cabfiles}[$i];
1391 unpack_cabinet_file($cabfile, $unpackdir);
1392}
1393
1393
1394# Reading tables
1395$filename = $helperdir . $separator . "Directory.idt";
1396$filecontent = read_file($filename);
1397my $dirhash = analyze_directory_file($filecontent);
1394# Reading tables
1395$filename = $helperdir . $separator . "Directory.idt";
1396$filecontent = read_file($filename);
1397my $dirhash = analyze_directory_file($filecontent);
1398
1398
1399$filename = $helperdir . $separator . "Component.idt";
1400$filecontent = read_file($filename);
1401my $componenthash = analyze_component_file($filecontent);
1399$filename = $helperdir . $separator . "Component.idt";
1400$filecontent = read_file($filename);
1401my $componenthash = analyze_component_file($filecontent);
1402
1402
1403$filename = $helperdir . $separator . "File.idt";
1404$filecontent = read_file($filename);
1405my ( $filehash, $fileorder, $maxsequence ) = analyze_file_file($filecontent);
1406
1407# Creating the directory structure
1408my $fullpathhash = create_directory_structure($dirhash, $targetdir);
1409
1410# Copying files
1411my ($unopkgfile) = copy_files_into_directory_structure($fileorder, $filehash, $componenthash, $fullpathhash, $maxsequence, $unpackdir, $installdir, $dirhash);
1412if ( $^O =~ /cygwin/i ) { change_privileges_full($targetdir); }
1403$filename = $helperdir . $separator . "File.idt";
1404$filecontent = read_file($filename);
1405my ( $filehash, $fileorder, $maxsequence ) = analyze_file_file($filecontent);
1406
1407# Creating the directory structure
1408my $fullpathhash = create_directory_structure($dirhash, $targetdir);
1409
1410# Copying files
1411my ($unopkgfile) = copy_files_into_directory_structure($fileorder, $filehash, $componenthash, $fullpathhash, $maxsequence, $unpackdir, $installdir, $dirhash);
1412if ( $^O =~ /cygwin/i ) { change_privileges_full($targetdir); }
1413
1413
1414my $msidatabase = $targetdir . $separator . $databasefilename;
1415my $copyreturn = copy($databasepath, $msidatabase);
1416if ( ! $copyreturn) { exit_program("ERROR: Could not copy $source to $dest\n"); }
1417
1418# Reading tables
1419$filename = $helperdir . $separator . "CustomAction.idt";
1420$filecontent = read_file($filename);
1421my $register_extensions_exists = analyze_customaction_file($filecontent);

--- 18 unchanged lines hidden --- 		1414my $msidatabase = $targetdir . $separator . $databasefilename;
1415my $copyreturn = copy($databasepath, $msidatabase);
1416if ( ! $copyreturn) { exit_program("ERROR: Could not copy $source to $dest\n"); }
1417
1418# Reading tables
1419$filename = $helperdir . $separator . "CustomAction.idt";
1420$filecontent = read_file($filename);
1421my $register_extensions_exists = analyze_customaction_file($filecontent);

--- 18 unchanged lines hidden ---