1#************************************************************** 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 10# 11# http://www.apache.org/licenses/LICENSE-2.0 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. 19# 20#************************************************************** 21 22 23 24package installer::systemactions; 25 26use Cwd; 27use File::Copy; 28use installer::converter; 29use installer::exiter; 30use installer::globals; 31use installer::pathanalyzer; 32use installer::remover; 33 34###################################################### 35# Creating a new direcotory 36###################################################### 37 38sub create_directory 39{ 40 my ($directory) = @_; 41 42 my $returnvalue = 1; 43 my $infoline = ""; 44 45 if (!(-d $directory)) 46 { 47 $returnvalue = mkdir($directory, 0775); 48 49 if ($returnvalue) 50 { 51 $infoline = "\nCreated directory: $directory\n"; 52 push(@installer::globals::logfileinfo, $infoline); 53 54 my $localcall = "chmod 0775 $directory \>\/dev\/null 2\>\&1"; 55 system($localcall); 56 57 # chmod 0775 is not sufficient on mac to remove sticky tag 58 $localcall = "chmod a-s $directory \>\/dev\/null 2\>\&1"; 59 system($localcall); 60 } 61 else 62 { 63 # New solution in parallel packing: It is possible, that the directory now exists, although it 64 # was not created in this process. There is only an important error, if the directory does not 65 # exist now. 66 67 $infoline = "\nDid not succeed in creating directory: \"$directory\". Further attempts will follow.\n"; 68 push(@installer::globals::logfileinfo, $infoline); 69 70 if (!(-d $directory)) 71 { 72 # Problem with parallel packaging? -> Try a little harder, before exiting. 73 # Did someone else remove the parent directory in the meantime? 74 my $parentdir = $directory; 75 installer::pathanalyzer::get_path_from_fullqualifiedname(\$parentdir); 76 if (!(-d $parentdir)) 77 { 78 $returnvalue = mkdir($parentdir, 0775); 79 80 if ($returnvalue) 81 { 82 $infoline = "\nAttention: Successfully created parent directory (should already be created before): $parentdir\n"; 83 push(@installer::globals::logfileinfo, $infoline); 84 85 my $localcall = "chmod 775 $parentdir \>\/dev\/null 2\>\&1"; 86 system($localcall); 87 } 88 else 89 { 90 $infoline = "\Error: \"$directory\" could not be created. Even the parent directory \"$parentdir\" does not exist and could not be created.\n"; 91 push(@installer::globals::logfileinfo, $infoline); 92 if ( -d $parentdir ) 93 { 94 $infoline = "\nAttention: Finally the parent directory \"$parentdir\" exists, but I could not create it.\n"; 95 push(@installer::globals::logfileinfo, $infoline); 96 } 97 else 98 { 99 # Now it is time to exit, even the parent could not be created. 100 installer::exiter::exit_program("ERROR: Could not create parent directory \"$parentdir\"", "create_directory"); 101 } 102 } 103 } 104 105 # At this point we have to assume, that the parent directory exist. 106 # Trying once more to create the desired directory 107 108 $returnvalue = mkdir($directory, 0775); 109 110 if ($returnvalue) 111 { 112 $infoline = "\nAttention: Created directory \"$directory\" in the second try.\n"; 113 push(@installer::globals::logfileinfo, $infoline); 114 115 my $localcall = "chmod 775 $directory \>\/dev\/null 2\>\&1"; 116 system($localcall); 117 } 118 else 119 { 120 if ( -d $directory ) 121 { 122 $infoline = "\nAttention: Finally the directory \"$directory\" exists, but I could not create it.\n"; 123 push(@installer::globals::logfileinfo, $infoline); 124 } 125 else 126 { 127 # It is time to exit, even the second try failed. 128 installer::exiter::exit_program("ERROR: Failed to create the directory: $directory", "create_directory"); 129 } 130 } 131 } 132 else 133 { 134 $infoline = "\nAnother process created this directory in exactly this moment :-) : $directory\n"; 135 push(@installer::globals::logfileinfo, $infoline); 136 } 137 } 138 } 139 else 140 { 141 $infoline = "\nAlready existing directory, did not create: $directory\n"; 142 push(@installer::globals::logfileinfo, $infoline); 143 } 144} 145 146###################################################### 147# Creating a new direcotory with defined privileges 148###################################################### 149 150sub create_directory_with_privileges 151{ 152 my ($directory, $privileges) = @_; 153 154 my $returnvalue = 1; 155 my $infoline = ""; 156 157 if (!(-d $directory)) 158 { 159 my $localprivileges = oct("0".$privileges); # changes "777" to 0777 160 $returnvalue = mkdir($directory, $localprivileges); 161 162 if ($returnvalue) 163 { 164 $infoline = "\nCreated directory: $directory\n"; 165 push(@installer::globals::logfileinfo, $infoline); 166 167 my $localcall = "chmod $privileges $directory \>\/dev\/null 2\>\&1"; 168 system($localcall); 169 } 170 else 171 { 172 # New solution in parallel packing: It is possible, that the directory now exists, although it 173 # was not created in this process. There is only an important error, if the directory does not 174 # exist now. 175 176 $infoline = "\nDid not succeed in creating directory: \"$directory\". Further attempts will follow.\n"; 177 push(@installer::globals::logfileinfo, $infoline); 178 179 if (!(-d $directory)) 180 { 181 # Problem with parallel packaging? -> Try a little harder, before exiting. 182 # Did someone else remove the parent directory in the meantime? 183 my $parentdir = $directory; 184 installer::pathanalyzer::get_path_from_fullqualifiedname(\$parentdir); 185 if (!(-d $parentdir)) 186 { 187 $returnvalue = mkdir($directory, $localprivileges); 188 189 if ($returnvalue) 190 { 191 $infoline = "\nAttention: Successfully created parent directory (should already be created before): $parentdir\n"; 192 push(@installer::globals::logfileinfo, $infoline); 193 194 my $localcall = "chmod $privileges $parentdir \>\/dev\/null 2\>\&1"; 195 system($localcall); 196 } 197 else 198 { 199 $infoline = "\Error: \"$directory\" could not be created. Even the parent directory \"$parentdir\" does not exist and could not be created.\n"; 200 push(@installer::globals::logfileinfo, $infoline); 201 if ( -d $parentdir ) 202 { 203 $infoline = "\nAttention: Finally the parent directory \"$parentdir\" exists, but I could not create it.\n"; 204 push(@installer::globals::logfileinfo, $infoline); 205 } 206 else 207 { 208 # Now it is time to exit, even the parent could not be created. 209 installer::exiter::exit_program("ERROR: Could not create parent directory \"$parentdir\"", "create_directory_with_privileges"); 210 } 211 } 212 } 213 214 # At this point we have to assume, that the parent directory exist. 215 # Trying once more to create the desired directory 216 217 $returnvalue = mkdir($directory, $localprivileges); 218 219 if ($returnvalue) 220 { 221 $infoline = "\nAttention: Created directory \"$directory\" in the second try.\n"; 222 push(@installer::globals::logfileinfo, $infoline); 223 224 my $localcall = "chmod $privileges $directory \>\/dev\/null 2\>\&1"; 225 system($localcall); 226 } 227 else 228 { 229 if ( -d $directory ) 230 { 231 $infoline = "\nAttention: Finally the directory \"$directory\" exists, but I could not create it.\n"; 232 push(@installer::globals::logfileinfo, $infoline); 233 } 234 else 235 { 236 # It is time to exit, even the second try failed. 237 installer::exiter::exit_program("ERROR: Failed to create the directory: $directory", "create_directory_with_privileges"); 238 } 239 } 240 } 241 else 242 { 243 $infoline = "\nAnother process created this directory in exactly this moment :-) : $directory\n"; 244 push(@installer::globals::logfileinfo, $infoline); 245 } 246 } 247 } 248 else 249 { 250 $infoline = "\nAlready existing directory, did not create: $directory\n"; 251 push(@installer::globals::logfileinfo, $infoline); 252 253 my $localcall = "chmod $privileges $directory \>\/dev\/null 2\>\&1"; 254 system($localcall); 255 } 256} 257 258###################################################### 259# Removing a new direcotory 260###################################################### 261 262sub remove_empty_directory 263{ 264 my ($directory) = @_; 265 266 my $returnvalue = 1; 267 268 if (-d $directory) 269 { 270 my $systemcall = "rmdir $directory"; 271 272 $returnvalue = system($systemcall); 273 274 my $infoline = "Systemcall: $systemcall\n"; 275 push( @installer::globals::logfileinfo, $infoline); 276 277 if ($returnvalue) 278 { 279 $infoline = "ERROR: Could not remove \"$directory\"!\n"; 280 push( @installer::globals::logfileinfo, $infoline); 281 } 282 else 283 { 284 $infoline = "Success: Removed \"$directory\"!\n"; 285 push( @installer::globals::logfileinfo, $infoline); 286 } 287 } 288} 289 290####################################################################### 291# Calculating the number of languages in the string 292####################################################################### 293 294sub get_number_of_langs 295{ 296 my ($languagestring) = @_; 297 298 my $number = 1; 299 300 my $workstring = $languagestring; 301 302 while ( $workstring =~ /^\s*(.*)_(.*?)\s*$/ ) 303 { 304 $workstring = $1; 305 $number++; 306 } 307 308 return $number; 309} 310 311####################################################################### 312# Creating the directories, in which files are generated or unzipped 313####################################################################### 314 315sub create_directories 316{ 317 my ($newdirectory, $languagesref) =@_; 318 319 $installer::globals::unpackpath =~ s/\Q$installer::globals::separator\E\s*$//; # removing ending slashes and backslashes 320 321 my $path = ""; 322 323 if (( $newdirectory eq "uno" ) || ( $newdirectory eq "zip" ) || ( $newdirectory eq "cab" ) || ( $newdirectory =~ /rdb\s*$/i )) # special handling for zip files, cab files and services file because of performance reasons 324 { 325 if ( $installer::globals::temppathdefined ) { $path = $installer::globals::temppath; } 326 else { $path = $installer::globals::unpackpath; } 327 $path =~ s/\Q$installer::globals::separator\E\s*$//; # removing ending slashes and backslashes 328 $path = $path . $installer::globals::separator; 329 } 330 elsif ( ( $newdirectory eq "jds" ) ) 331 { 332 if ( $installer::globals::jdstemppathdefined ) { $path = $installer::globals::jdstemppath; } 333 else { $path = $installer::globals::unpackpath; } 334 $path =~ s/\Q$installer::globals::separator\E\s*$//; # removing ending slashes and backslashes 335 $path = $path . $installer::globals::separator; 336 installer::systemactions::create_directory($path); 337 } 338 else 339 { 340 $path = $installer::globals::unpackpath . $installer::globals::separator; 341 342 # special handling, if LOCALINSTALLDIR is set 343 if (( $installer::globals::localinstalldirset ) && ( $newdirectory eq "install" )) 344 { 345 $installer::globals::localinstalldir =~ s/\Q$installer::globals::separator\E\s*$//; 346 $path = $installer::globals::localinstalldir . $installer::globals::separator; 347 } 348 } 349 350 $infoline = "create_directories: Using $path for $newdirectory !\n"; 351 push( @installer::globals::logfileinfo, $infoline); 352 353 if ($newdirectory eq "unzip" ) # special handling for common directory 354 { 355 $path = $path . ".." . $installer::globals::separator . "common" . $installer::globals::productextension . $installer::globals::separator; 356 create_directory($path); 357 358 $path = $path . $newdirectory . $installer::globals::separator; 359 create_directory($path); 360 } 361 else 362 { 363 my $localproductname = $installer::globals::product; 364 my $localproductsubdir = ""; 365 366 if ( $installer::globals::product =~ /^\s*(.+?)\_\_(.+?)\s*$/ ) 367 { 368 $localproductname = $1; 369 $localproductsubdir = $2; 370 } 371 372 if ( $installer::globals::languagepack ) { $path = $path . $localproductname . "_languagepack" . $installer::globals::separator; } 373 elsif ( $installer::globals::patch ) { $path = $path . $localproductname . "_patch" . $installer::globals::separator; } 374 else { $path = $path . $localproductname . $installer::globals::separator; } 375 376 create_directory($path); 377 378 if ( $localproductsubdir ) 379 { 380 $path = $path . $localproductsubdir . $installer::globals::separator; 381 create_directory($path); 382 } 383 384 $path = $path . $installer::globals::installertypedir . $installer::globals::separator; 385 create_directory($path); 386 387 $path = $path . $newdirectory . $installer::globals::separator; 388 create_directory($path); 389 390 my $locallanguagesref = ""; 391 392 if ( $$languagesref ) { $locallanguagesref = $$languagesref; } 393 394 if (!($locallanguagesref eq "" )) # this will be a path like "01_49", for Profiles and ConfigurationFiles, idt-Files 395 { 396 my $languagestring = $$languagesref; 397 398 if (length($languagestring) > $installer::globals::max_lang_length ) 399 { 400 my $number_of_languages = get_number_of_langs($languagestring); 401 chomp(my $shorter = `echo $languagestring | md5sum | sed -e "s/ .*//g"`); 402 # $languagestring = $shorter; 403 my $id = substr($shorter, 0, 8); # taking only the first 8 digits 404 $languagestring = "lang_" . $number_of_languages . "_id_" . $id; 405 } 406 407 $path = $path . $languagestring . $installer::globals::separator; 408 create_directory($path); 409 } 410 } 411 412 installer::remover::remove_ending_pathseparator(\$path); 413 414 $path = installer::converter::make_path_conform($path); 415 416 return $path; 417} 418 419######################## 420# Copying one file 421######################## 422 423sub copy_one_file 424{ 425 my ($source, $dest) = @_; 426 427 my ($returnvalue, $infoline); 428 429 430 # copy returns 0 if files are identical :-( 431 if ( $installer::globals::isos2 ) { 432 unlink($dest); 433 } 434 435 my $copyreturn = copy($source, $dest); 436 437 if ($copyreturn) 438 { 439 $infoline = "Copy: $source to $dest\n"; 440 $returnvalue = 1; 441 } 442 else 443 { 444 $infoline = "ERROR: Could not copy $source to $dest\n"; 445 $returnvalue = 0; 446 } 447 448 push(@installer::globals::logfileinfo, $infoline); 449 450 if ( !$returnvalue ) { 451 return $returnvalue; 452 } 453 454 # taking care of file attributes 455 if ($installer::globals::iswin && -f $dest) { 456 my $mode = -x $source ? 0775 : 0664; 457 my $mode_str = sprintf("%o", $mode); 458 my $chmodreturn = chmod($mode, $dest); 459 if ($chmodreturn) 460 { 461 $infoline = "chmod $mode_str, $dest\n"; 462 $returnvalue = 1; 463 } 464 else 465 { 466 $infoline = "WARNING: Could not chmod $dest: $!\n"; 467 $returnvalue = 0; 468 } 469 470 push(@installer::globals::logfileinfo, $infoline); 471 } 472 473 return $returnvalue; 474} 475 476########################## 477# Hard linking one file 478########################## 479 480sub hardlink_one_file 481{ 482 my ($source, $dest) = @_; 483 484 my ($returnvalue, $infoline); 485 486 my $copyreturn = link($source, $dest); 487 488 if ($copyreturn) 489 { 490 $infoline = "Link: $source to $dest\n"; 491 $returnvalue = 1; 492 } 493 else 494 { 495 $infoline = "ERROR: Could not link $source to $dest\n"; 496 $returnvalue = 0; 497 } 498 499 push(@installer::globals::logfileinfo, $infoline); 500 501 return $returnvalue; 502} 503 504########################## 505# Soft linking one file 506########################## 507 508sub softlink_one_file 509{ 510 my ($source, $dest) = @_; 511 512 my ($returnvalue, $infoline); 513 514 my $linkreturn = symlink($source, $dest); 515 516 if ($linkreturn) 517 { 518 $infoline = "Symlink: $source to $dest\n"; 519 $returnvalue = 1; 520 } 521 else 522 { 523 $infoline = "ERROR: Could not symlink $source to $dest\n"; 524 $returnvalue = 0; 525 } 526 527 push(@installer::globals::logfileinfo, $infoline); 528 529 return $returnvalue; 530} 531 532######################## 533# Renaming one file 534######################## 535 536sub rename_one_file 537{ 538 my ($source, $dest) = @_; 539 540 my ($returnvalue, $infoline); 541 542 my $renamereturn = rename($source, $dest); 543 544 if ($renamereturn) 545 { 546 $infoline = "Rename: $source to $dest\n"; 547 $returnvalue = 1; 548 } 549 else 550 { 551 $infoline = "ERROR: Could not rename $source to $dest\n"; 552 $returnvalue = 0; 553 } 554 555 push(@installer::globals::logfileinfo, $infoline); 556 557 return $returnvalue; 558} 559 560########################################## 561# Copying all files from one directory 562# to another directory 563########################################## 564 565sub copy_directory 566{ 567 my ($sourcedir, $destdir) = @_; 568 569 my @sourcefiles = (); 570 571 $sourcedir =~ s/\Q$installer::globals::separator\E\s*$//; 572 $destdir =~ s/\Q$installer::globals::separator\E\s*$//; 573 574 my $infoline = "\n"; 575 push(@installer::globals::logfileinfo, $infoline); 576 $infoline = "Copying files from directory $sourcedir to directory $destdir\n"; 577 push(@installer::globals::logfileinfo, $infoline); 578 579 opendir(DIR, $sourcedir); 580 @sourcefiles = readdir(DIR); 581 closedir(DIR); 582 583 my $onefile; 584 585 foreach $onefile (@sourcefiles) 586 { 587 if ((!($onefile eq ".")) && (!($onefile eq ".."))) 588 { 589 my $sourcefile = $sourcedir . $installer::globals::separator . $onefile; 590 my $destfile = $destdir . $installer::globals::separator . $onefile; 591 if ( -f $sourcefile ) # only files, no directories 592 { 593 copy_one_file($sourcefile, $destfile); 594 } 595 } 596 } 597} 598 599########################################## 600# Copying all files from one directory 601# to another directory 602########################################## 603 604sub is_empty_dir 605{ 606 my ($dir) = @_; 607 608 my $directory_is_empty = 1; 609 my @sourcefiles = (); 610 611 opendir(DIR, $dir); 612 @sourcefiles = readdir(DIR); 613 closedir(DIR); 614 615 my $onefile; 616 my @realcontent = (); 617 618 foreach $onefile (@sourcefiles) 619 { 620 if ((!($onefile eq ".")) && (!($onefile eq ".."))) 621 { 622 push(@realcontent, $onefile); 623 } 624 } 625 626 if ( $#realcontent > -1 ) { $directory_is_empty = 0; } 627 628 return $directory_is_empty; 629} 630 631##################################################################### 632# Creating hard links to a complete directory with sub directories. 633##################################################################### 634 635sub hardlink_complete_directory 636{ 637 my ($sourcedir, $destdir) = @_; 638 639 my @sourcefiles = (); 640 641 $sourcedir =~ s/\Q$installer::globals::separator\E\s*$//; 642 $destdir =~ s/\Q$installer::globals::separator\E\s*$//; 643 644 if ( ! -d $destdir ) { create_directory($destdir); } 645 646 my $infoline = "\n"; 647 push(@installer::globals::logfileinfo, $infoline); 648 $infoline = "Creating hard links for all files from directory $sourcedir to directory $destdir\n"; 649 push(@installer::globals::logfileinfo, $infoline); 650 651 opendir(DIR, $sourcedir); 652 @sourcefiles = readdir(DIR); 653 closedir(DIR); 654 655 my $onefile; 656 657 foreach $onefile (@sourcefiles) 658 { 659 if ((!($onefile eq ".")) && (!($onefile eq ".."))) 660 { 661 my $source = $sourcedir . $installer::globals::separator . $onefile; 662 my $dest = $destdir . $installer::globals::separator . $onefile; 663 if ( -f $source ) # only files, no directories 664 { 665 hardlink_one_file($source, $dest); 666 } 667 if ( -d $source ) # recursive 668 { 669 hardlink_complete_directory($source, $dest); 670 } 671 } 672 } 673} 674 675##################################################################### 676# Creating hard links to a complete directory with sub directories. 677##################################################################### 678 679sub softlink_complete_directory 680{ 681 my ($sourcedir, $destdir, $depth) = @_; 682 683 my @sourcefiles = (); 684 685 $sourcedir =~ s/\Q$installer::globals::separator\E\s*$//; 686 $destdir =~ s/\Q$installer::globals::separator\E\s*$//; 687 688 if ( ! -d $destdir ) { create_directory($destdir); } 689 690 my $infoline = "\n"; 691 push(@installer::globals::logfileinfo, $infoline); 692 $infoline = "Creating soft links for all files from directory $sourcedir to directory $destdir\n"; 693 push(@installer::globals::logfileinfo, $infoline); 694 695 opendir(DIR, $sourcedir); 696 @sourcefiles = readdir(DIR); 697 closedir(DIR); 698 699 my $onefile; 700 701 foreach $onefile (@sourcefiles) 702 { 703 if ((!($onefile eq ".")) && (!($onefile eq ".."))) 704 { 705 my $source = $sourcedir . $installer::globals::separator . $onefile; 706 my $dest = $destdir . $installer::globals::separator . $onefile; 707 if ( -f $source ) # only files, no directories 708 { 709 my $localsource = $source; 710 if ( $depth > 0 ) { for ( my $i = 1; $i <= $depth; $i++ ) { $localsource = "../" . $localsource; } } 711 softlink_one_file($localsource, $dest); 712 } 713 if ( -d $source ) # recursive 714 { 715 my $newdepth = $depth + 1; 716 softlink_complete_directory($source, $dest, $newdepth); 717 } 718 } 719 } 720} 721 722##################################################### 723# Copying a complete directory with sub directories. 724##################################################### 725 726sub copy_complete_directory 727{ 728 my ($sourcedir, $destdir) = @_; 729 730 my @sourcefiles = (); 731 732 $sourcedir =~ s/\Q$installer::globals::separator\E\s*$//; 733 $destdir =~ s/\Q$installer::globals::separator\E\s*$//; 734 735 if ( ! -d $destdir ) { create_directory($destdir); } 736 737 my $infoline = "\n"; 738 push(@installer::globals::logfileinfo, $infoline); 739 $infoline = "Copying files from directory $sourcedir to directory $destdir\n"; 740 push(@installer::globals::logfileinfo, $infoline); 741 742 opendir(DIR, $sourcedir); 743 @sourcefiles = readdir(DIR); 744 closedir(DIR); 745 746 my $onefile; 747 748 foreach $onefile (@sourcefiles) 749 { 750 if ((!($onefile eq ".")) && (!($onefile eq ".."))) 751 { 752 my $source = $sourcedir . $installer::globals::separator . $onefile; 753 my $dest = $destdir . $installer::globals::separator . $onefile; 754 if ( -f $source ) # only files, no directories 755 { 756 copy_one_file($source, $dest); 757 } 758 if ( -d $source ) # recursive 759 { 760 if ((!( $source =~ /packages\/SUNW/ )) && (!( $source =~ /packages\/OOO/ ))) # do not copy complete Solaris packages! 761 { 762 copy_complete_directory($source, $dest); 763 } 764 } 765 } 766 } 767} 768 769##################################################################################### 770# Copying a complete directory with sub directories, but not the CVS directories. 771##################################################################################### 772 773sub copy_complete_directory_without_cvs 774{ 775 my ($sourcedir, $destdir) = @_; 776 777 my @sourcefiles = (); 778 779 $sourcedir =~ s/\Q$installer::globals::separator\E\s*$//; 780 $destdir =~ s/\Q$installer::globals::separator\E\s*$//; 781 782 if ( ! -d $destdir ) { create_directory($destdir); } 783 784 my $infoline = "\n"; 785 push(@installer::globals::logfileinfo, $infoline); 786 $infoline = "Copying files from directory $sourcedir to directory $destdir (without CVS)\n"; 787 push(@installer::globals::logfileinfo, $infoline); 788 789 opendir(DIR, $sourcedir); 790 @sourcefiles = readdir(DIR); 791 closedir(DIR); 792 793 my $onefile; 794 795 foreach $onefile (@sourcefiles) 796 { 797 if ((!($onefile eq ".")) && (!($onefile eq "..")) && (!($onefile eq "CVS"))) 798 { 799 my $source = $sourcedir . $installer::globals::separator . $onefile; 800 my $dest = $destdir . $installer::globals::separator . $onefile; 801 if ( -f $source ) # only files, no directories 802 { 803 copy_one_file($source, $dest); 804 } 805 if ( -d $source ) # recursive 806 { 807 copy_complete_directory_without_cvs($source, $dest); 808 } 809 } 810 } 811} 812 813##################################################### 814# Copying all files with a specified file extension 815# from one directory to another directory. 816##################################################### 817 818sub copy_directory_with_fileextension 819{ 820 my ($sourcedir, $destdir, $extension) = @_; 821 822 my @sourcefiles = (); 823 824 $sourcedir =~ s/\Q$installer::globals::separator\E\s*$//; 825 $destdir =~ s/\Q$installer::globals::separator\E\s*$//; 826 827 $infoline = "\n"; 828 push(@installer::globals::logfileinfo, $infoline); 829 $infoline = "Copying files with extension $extension from directory $sourcedir to directory $destdir\n"; 830 push(@installer::globals::logfileinfo, $infoline); 831 832 opendir(DIR, $sourcedir); 833 @sourcefiles = readdir(DIR); 834 closedir(DIR); 835 836 my $onefile; 837 838 foreach $onefile (@sourcefiles) 839 { 840 if ((!($onefile eq ".")) && (!($onefile eq ".."))) 841 { 842 if ( $onefile =~ /\.$extension\s*$/ ) # only copying specified files 843 { 844 my $sourcefile = $sourcedir . $installer::globals::separator . $onefile; 845 my $destfile = $destdir . $installer::globals::separator . $onefile; 846 if ( -f $sourcefile ) # only files, no directories 847 { 848 copy_one_file($sourcefile, $destfile); 849 } 850 } 851 } 852 } 853} 854 855######################################################### 856# Copying all files without a specified file extension 857# from one directory to another directory. 858######################################################### 859 860sub copy_directory_except_fileextension 861{ 862 my ($sourcedir, $destdir, $extension) = @_; 863 864 my @sourcefiles = (); 865 866 $sourcedir =~ s/\Q$installer::globals::separator\E\s*$//; 867 $destdir =~ s/\Q$installer::globals::separator\E\s*$//; 868 869 $infoline = "\n"; 870 push(@installer::globals::logfileinfo, $infoline); 871 $infoline = "Copying files without extension $extension from directory $sourcedir to directory $destdir\n"; 872 push(@installer::globals::logfileinfo, $infoline); 873 874 opendir(DIR, $sourcedir); 875 @sourcefiles = readdir(DIR); 876 closedir(DIR); 877 878 my $onefile; 879 880 foreach $onefile (@sourcefiles) 881 { 882 if ((!($onefile eq ".")) && (!($onefile eq ".."))) 883 { 884 if ( ! ( $onefile =~ /\.$extension\s*$/ )) # only copying not having the specified extension 885 { 886 my $sourcefile = $sourcedir . $installer::globals::separator . $onefile; 887 my $destfile = $destdir . $installer::globals::separator . $onefile; 888 if ( -f $sourcefile ) # only files, no directories 889 { 890 copy_one_file($sourcefile, $destfile); 891 } 892 } 893 } 894 } 895} 896 897######################################################## 898# Renaming all files with a specified file extension 899# in a specified directory. 900# Example: "Feature.idt.01" -> "Feature.idt" 901######################################################## 902 903sub rename_files_with_fileextension 904{ 905 my ($dir, $extension) = @_; 906 907 my @sourcefiles = (); 908 909 $dir =~ s/\Q$installer::globals::separator\E\s*$//; 910 911 my $infoline = "\n"; 912 push(@installer::globals::logfileinfo, $infoline); 913 $infoline = "Renaming files with extension \"$extension\" in the directory $dir\n"; 914 push(@installer::globals::logfileinfo, $infoline); 915 916 opendir(DIR, $dir); 917 @sourcefiles = readdir(DIR); 918 closedir(DIR); 919 920 my $onefile; 921 922 foreach $onefile (@sourcefiles) 923 { 924 if ((!($onefile eq ".")) && (!($onefile eq ".."))) 925 { 926 if ( $onefile =~ /^\s*(\S.*?)\.$extension\s*$/ ) # only renaming specified files 927 { 928 my $destfile = $1; 929 my $sourcefile = $dir . $installer::globals::separator . $onefile; 930 $destfile = $dir . $installer::globals::separator . $destfile; 931 if ( -f $sourcefile ) # only files, no directories 932 { 933 rename_one_file($sourcefile, $destfile); 934 } 935 } 936 } 937 } 938} 939 940######################################################## 941# Finding all files with a specified file extension 942# in a specified directory. 943######################################################## 944 945sub find_file_with_file_extension 946{ 947 my ($extension, $dir) = @_; 948 949 my @allfiles = (); 950 951 $dir =~ s/\Q$installer::globals::separator\E\s*$//; 952 953 my $infoline = "\n"; 954 push(@installer::globals::logfileinfo, $infoline); 955 $infoline = "Searching files with extension \"$extension\" in the directory $dir\n"; 956 push(@installer::globals::logfileinfo, $infoline); 957 958 opendir(DIR, $dir); 959 @sourcefiles = sort readdir(DIR); 960 closedir(DIR); 961 962 my $onefile; 963 964 foreach $onefile (@sourcefiles) 965 { 966 if ((!($onefile eq ".")) && (!($onefile eq ".."))) 967 { 968 if ( $onefile =~ /^\s*(\S.*?)\.$extension\s*$/ ) 969 { 970 push(@allfiles, $onefile) 971 } 972 } 973 } 974 975 return \@allfiles; 976} 977 978############################################################## 979# Creating a unique directory, for example "01_inprogress_7" 980# in the install directory. 981############################################################## 982 983sub make_numbered_dir 984{ 985 my ($newstring, $olddir) = @_; 986 987 my $basedir = $olddir; 988 installer::pathanalyzer::get_path_from_fullqualifiedname(\$basedir); 989 990 my $alldirs = get_all_directories($basedir); 991 992 # searching for the highest number extension 993 994 my $maxnumber = 0; 995 996 for ( my $i = 0; $i <= $#{$alldirs}; $i++ ) 997 { 998 if ( ${$alldirs}[$i] =~ /\_(\d+)\s*$/ ) 999 { 1000 my $number = $1; 1001 if ( $number > $maxnumber ) { $maxnumber = $number; } 1002 } 1003 } 1004 1005 my $newnumber = $maxnumber + 1; 1006 1007 my $newdir = $olddir . "_" . $newstring . "_" . $newnumber; 1008 1009 my $returndir = ""; 1010 1011 if ( move($olddir, $newdir) ) 1012 { 1013 $infoline = "\nMoved directory from $olddir to $newdir\n"; 1014 push(@installer::globals::logfileinfo, $infoline); 1015 $returndir = $newdir; 1016 } 1017 else 1018 { 1019 $infoline = "\nATTENTION: Could not move directory from $olddir to $newdir, \"make_numbered_dir\"\n"; 1020 push(@installer::globals::logfileinfo, $infoline); 1021 $returndir = $olddir; 1022 } 1023 1024 return $returndir; 1025} 1026 1027############################################################## 1028# Determining the highest number in the install directory. 1029############################################################## 1030 1031sub determine_maximum_number 1032{ 1033 my ($dir, $languagestringref) = @_; 1034 1035 my $basedir = $dir; 1036 installer::pathanalyzer::get_path_from_fullqualifiedname(\$basedir); 1037 1038 my $alldirs = get_all_directories($basedir); 1039 1040 my $maxnumber = 1; 1041 1042 # In control.pm the installation directory is determined as: 1043 # $installer::globals::build . "_" . $installer::globals::lastminor . "_" . 1044 # "native_inprogress-number_" . $$languagesref . "\." . $installer::globals::buildid; 1045 1046 # searching for the highest number extension after the first "-", which belongs to 1047 # $installer::globals::build, $installer::globals::lastminor and $installer::globals::buildid 1048 # In this step not looking for the language! 1049 1050 my @correctbuildiddirs = (); 1051 1052 for ( my $i = 0; $i <= $#{$alldirs}; $i++ ) 1053 { 1054 my $onedir = ${$alldirs}[$i]; 1055 installer::pathanalyzer::make_absolute_filename_to_relative_filename(\$onedir); 1056 1057 if ( $onedir =~ /^\s*\Q$installer::globals::build\E\_\Q$installer::globals::lastminor\E\_(.*?)\-(\d+)\_(.*?)\.\Q$installer::globals::buildid\E\s*$/ ) 1058 { 1059 my $number = $2; 1060 if ( $number > $maxnumber ) { $maxnumber = $number; } 1061 push(@correctbuildiddirs, $onedir); 1062 } 1063 } 1064 1065 # From all directories with correct $installer::globals::build, $installer::globals::lastminor 1066 # and $installer::globals::buildid, those directories, which already have the maximum number 1067 # have to be selected 1068 1069 my @maximumnumberdirs = (); 1070 1071 for ( my $i = 0; $i <= $#correctbuildiddirs; $i++ ) 1072 { 1073 my $onedir = $correctbuildiddirs[$i]; 1074 1075 if ( $onedir =~ /^\s*(.*?)\-(\d+)\_(.*?)\.(.*?)\s*$/ ) 1076 { 1077 my $number = $2; 1078 1079 if ( $number == $maxnumber ) 1080 { 1081 push(@maximumnumberdirs, $onedir); 1082 } 1083 } 1084 } 1085 1086 # @maximumnumberdirs contains only those directories with correct $installer::globals::build, 1087 # $installer::globals::lastminor and $installer::globals::buildid, which already have the maximum number. 1088 # If the current language is part of this directory, the number has to be increased. 1089 1090 my $increase_counter = 0; 1091 1092 for ( my $i = 0; $i <= $#maximumnumberdirs; $i++ ) 1093 { 1094 my $onedir = $maximumnumberdirs[$i]; 1095 1096 if ( $onedir =~ /^\s*(.*?)\-(\d+)\_(.*?)\.(.*?)\s*$/ ) 1097 { 1098 my $number = $2; 1099 my $languagestring = $3; 1100 1101 if ( $languagestring eq $$languagestringref ) 1102 { 1103 $increase_counter = 1; 1104 } 1105 } 1106 } 1107 1108 if ( $increase_counter ) 1109 { 1110 $maxnumber = $maxnumber + 1; 1111 } 1112 1113 return $maxnumber; 1114} 1115 1116##################################################################################### 1117# Renaming a directory by exchanging a string, for example from "01_inprogress_7" 1118# to "01_witherror_7". 1119##################################################################################### 1120 1121sub rename_string_in_directory 1122{ 1123 my ($olddir, $oldstring, $newstring) = @_; 1124 1125 my $newdir = $olddir; 1126 my $infoline = ""; 1127 1128 $newdir =~ s/$oldstring/$newstring/g; 1129 1130 if (( -d $newdir ) && ( $olddir ne $newdir )) { remove_complete_directory($newdir, 1); } 1131 1132 if ( move($olddir, $newdir) ) 1133 { 1134 $infoline = "\nMoved directory from $olddir to $newdir\n"; 1135 push(@installer::globals::logfileinfo, $infoline); 1136 } 1137 else 1138 { 1139 $infoline = "\nATTENTION: Could not move directory from $olddir to $newdir, \"rename_string_in_directory\"\n"; 1140 push(@installer::globals::logfileinfo, $infoline); 1141 } 1142 1143 return $newdir; 1144} 1145 1146###################################################### 1147# Returning the complete directory name, 1148# input is the first part of the directory name. 1149###################################################### 1150 1151sub get_directoryname 1152{ 1153 my ($searchdir, $startstring) = @_; 1154 1155 my $dirname = ""; 1156 my $founddir = 0; 1157 my $direntry; 1158 1159 opendir(DIR, $searchdir); 1160 1161 foreach $direntry (readdir (DIR)) 1162 { 1163 next if $direntry eq "."; 1164 next if $direntry eq ".."; 1165 1166 if (( -d $direntry ) && ( $direntry =~ /^\s*\Q$startstring\E/ )) 1167 { 1168 $dirname = $direntry; 1169 $founddir = 1; 1170 last; 1171 } 1172 } 1173 1174 closedir(DIR); 1175 1176 if ( ! $founddir ) { installer::exiter::exit_program("ERROR: Did not find directory beginning with $startstring in directory $searchdir", "get_directoryname"); } 1177 1178 return $dirname; 1179} 1180 1181 1182################################### 1183# Renaming a directory 1184################################### 1185 1186sub rename_directory 1187{ 1188 my ($olddir, $newdir) = @_; 1189 1190 my $infoline = ""; 1191 1192 # noticed problems under Windows from time to time that directories can't be moved, seems a timing issue 1193 # workaround with sleep, should be investigated with a new packaging mechanism 1194 sleep(2); 1195 if ( move($olddir, $newdir) ) 1196 { 1197 $infoline = "\nMoved directory from $olddir to $newdir\n"; 1198 push(@installer::globals::logfileinfo, $infoline); 1199 } 1200 else 1201 { 1202 installer::exiter::exit_program("ERROR: Could not move directory from $olddir to $newdir", "rename_directory"); 1203 # $infoline = "\nATTENTION: Could not move directory from $olddir to $newdir, \"rename_directory\"\n"; 1204 # push(@installer::globals::logfileinfo, $infoline); 1205 } 1206 1207 return $newdir; 1208} 1209 1210############################################################## 1211# Creating a directory next to an existing directory 1212############################################################## 1213 1214sub create_directory_next_to_directory 1215{ 1216 my ($topdir, $dirname) = @_; 1217 1218 my $basedir = $topdir; 1219 installer::pathanalyzer::get_path_from_fullqualifiedname(\$basedir); 1220 1221 $basedir =~ s/\Q$installer::globals::separator\E\s*$//; 1222 1223 my $newdir = $basedir . $installer::globals::separator . $dirname; 1224 1225 create_directory($newdir); 1226 1227 return $newdir; 1228} 1229 1230############################################################## 1231# Collecting all directories inside a directory 1232############################################################## 1233 1234sub get_all_directories 1235{ 1236 my ($basedir) = @_; 1237 1238 my @alldirs = (); 1239 my $direntry; 1240 1241 $basedir =~ s/\Q$installer::globals::separator\E\s*$//; 1242 1243 opendir(DIR, $basedir); 1244 1245 foreach $direntry (readdir (DIR)) 1246 { 1247 next if $direntry eq "."; 1248 next if $direntry eq ".."; 1249 1250 my $completeentry = $basedir . $installer::globals::separator . $direntry; 1251 1252 if ( -d $completeentry ) { push(@alldirs, $completeentry); } 1253 } 1254 1255 closedir(DIR); 1256 1257 return \@alldirs; 1258} 1259 1260############################################################## 1261# Collecting all directories inside a directory 1262# Returning without path 1263############################################################## 1264 1265sub get_all_directories_without_path 1266{ 1267 my ($basedir) = @_; 1268 1269 my @alldirs = (); 1270 my $direntry; 1271 1272 $basedir =~ s/\Q$installer::globals::separator\E\s*$//; 1273 1274 opendir(DIR, $basedir); 1275 1276 foreach $direntry (readdir (DIR)) 1277 { 1278 next if $direntry eq "."; 1279 next if $direntry eq ".."; 1280 1281 my $completeentry = $basedir . $installer::globals::separator . $direntry; 1282 1283 if ( -d $completeentry ) { push(@alldirs, $direntry); } 1284 } 1285 1286 closedir(DIR); 1287 1288 return \@alldirs; 1289} 1290 1291############################################################## 1292# Collecting all files inside one directory 1293############################################################## 1294 1295sub get_all_files_from_one_directory 1296{ 1297 my ($basedir) = @_; 1298 1299 my @allfiles = (); 1300 my $direntry; 1301 1302 $basedir =~ s/\Q$installer::globals::separator\E\s*$//; 1303 1304 opendir(DIR, $basedir); 1305 1306 foreach $direntry (readdir (DIR)) 1307 { 1308 next if $direntry eq "."; 1309 next if $direntry eq ".."; 1310 1311 my $completeentry = $basedir . $installer::globals::separator . $direntry; 1312 1313 if ( -f $completeentry ) { push(@allfiles, $completeentry); } 1314 } 1315 1316 closedir(DIR); 1317 1318 return \@allfiles; 1319} 1320 1321############################################################## 1322# Collecting all files inside one directory 1323############################################################## 1324 1325sub get_all_files_from_one_directory_without_path 1326{ 1327 my ($basedir) = @_; 1328 1329 my @allfiles = (); 1330 my $direntry; 1331 1332 $basedir =~ s/\Q$installer::globals::separator\E\s*$//; 1333 1334 opendir(DIR, $basedir); 1335 1336 foreach $direntry (readdir (DIR)) 1337 { 1338 next if $direntry eq "."; 1339 next if $direntry eq ".."; 1340 1341 my $completeentry = $basedir . $installer::globals::separator . $direntry; 1342 1343 if ( -f $completeentry ) { push(@allfiles, $direntry); } 1344 } 1345 1346 closedir(DIR); 1347 1348 return \@allfiles; 1349} 1350 1351############################################################## 1352# Collecting all files and directories inside one directory 1353############################################################## 1354 1355sub read_directory 1356{ 1357 my ($basedir) = @_; 1358 1359 my @allcontent = (); 1360 my $direntry; 1361 1362 $basedir =~ s/\Q$installer::globals::separator\E\s*$//; 1363 1364 opendir(DIR, $basedir); 1365 1366 foreach $direntry (readdir (DIR)) 1367 { 1368 next if $direntry eq "."; 1369 next if $direntry eq ".."; 1370 1371 my $completeentry = $basedir . $installer::globals::separator . $direntry; 1372 1373 if (( -f $completeentry ) || ( -d $completeentry )) { push(@allcontent, $completeentry); } 1374 } 1375 1376 closedir(DIR); 1377 1378 return \@allcontent; 1379} 1380 1381############################################################## 1382# Finding the new content in a directory 1383############################################################## 1384 1385sub find_new_content_in_directory 1386{ 1387 my ( $basedir, $oldcontent ) = @_; 1388 1389 my @newcontent = (); 1390 my @allcontent = (); 1391 1392 my $direntry; 1393 1394 $basedir =~ s/\Q$installer::globals::separator\E\s*$//; 1395 1396 opendir(DIR, $basedir); 1397 1398 foreach $direntry (readdir (DIR)) 1399 { 1400 next if $direntry eq "."; 1401 next if $direntry eq ".."; 1402 1403 my $completeentry = $basedir . $installer::globals::separator . $direntry; 1404 1405 if (( -f $completeentry ) || ( -d $completeentry )) 1406 { 1407 push(@allcontent, $completeentry); 1408 if (! installer::existence::exists_in_array($completeentry, $oldcontent)) 1409 { 1410 push(@newcontent, $completeentry); 1411 } 1412 } 1413 } 1414 1415 closedir(DIR); 1416 1417 return (\@newcontent, \@allcontent); 1418} 1419 1420############################################################## 1421# Trying to create a directory, no error if this fails 1422############################################################## 1423 1424sub try_to_create_directory 1425{ 1426 my ($directory) = @_; 1427 1428 my $returnvalue = 1; 1429 my $created_directory = 0; 1430 1431 if (!(-d $directory)) 1432 { 1433 $returnvalue = mkdir($directory, 0775); 1434 1435 if ($returnvalue) 1436 { 1437 $created_directory = 1; 1438 $infoline = "\nCreated directory: $directory\n"; 1439 push(@installer::globals::logfileinfo, $infoline); 1440 1441 my $localcall = "chmod 0775 $directory \>\/dev\/null 2\>\&1"; 1442 system($localcall); 1443 1444 # chmod 0775 is not sufficient on mac to remove sticky tag 1445 $localcall = "chmod a-s $directory \>\/dev\/null 2\>\&1"; 1446 system($localcall); 1447 } 1448 else 1449 { 1450 $created_directory = 0; 1451 } 1452 } 1453 else 1454 { 1455 $created_directory = 1; 1456 } 1457 1458 return $created_directory; 1459} 1460 1461############################################################## 1462# Creating a complete directory structure 1463############################################################## 1464 1465sub create_directory_structure 1466{ 1467 my ($directory) = @_; 1468 1469 if ( ! try_to_create_directory($directory) ) 1470 { 1471 my $parentdir = $directory; 1472 installer::pathanalyzer::get_path_from_fullqualifiedname(\$parentdir); 1473 1474 my $infoline = "INFO: Did not create directory $directory\n"; 1475 push(@installer::globals::logfileinfo, $infoline); 1476 $infoline = "Now trying to create parent directory $parentdir\n"; 1477 push(@installer::globals::logfileinfo, $infoline); 1478 1479 create_directory_structure($parentdir); # recursive 1480 } 1481 1482 create_directory($directory); # now it has to succeed 1483} 1484 1485###################################################### 1486# Removing a complete directory with subdirectories 1487###################################################### 1488 1489sub remove_complete_directory 1490{ 1491 my ($directory, $start) = @_; 1492 1493 my @content = (); 1494 my $infoline = ""; 1495 1496 $directory =~ s/\Q$installer::globals::separator\E\s*$//; 1497 1498 if ( -d $directory ) 1499 { 1500 if ( $start ) 1501 { 1502 $infoline = "\n"; 1503 push(@installer::globals::logfileinfo, $infoline); 1504 $infoline = "Removing directory $directory\n"; 1505 push(@installer::globals::logfileinfo, $infoline); 1506 } 1507 1508 opendir(DIR, $directory); 1509 @content = readdir(DIR); 1510 closedir(DIR); 1511 1512 my $oneitem; 1513 1514 foreach $oneitem (@content) 1515 { 1516 if ((!($oneitem eq ".")) && (!($oneitem eq ".."))) 1517 { 1518 my $item = $directory . $installer::globals::separator . $oneitem; 1519 1520 if ( -f $item || -l $item ) # deleting files or links 1521 { 1522 unlink($item); 1523 } 1524 1525 if ( -d $item ) # recursive 1526 { 1527 remove_complete_directory($item, 0); 1528 } 1529 } 1530 } 1531 1532 # try to remove empty directory 1533 1534 my $returnvalue = rmdir $directory; 1535 1536 if ( ! $returnvalue ) 1537 { 1538 $infoline = "Warning: Problem with removing empty dir $directory\n"; 1539 push(@installer::globals::logfileinfo, $infoline); 1540 } 1541 1542 # try a little bit harder (sometimes there is a performance problem) 1543 if ( -d $directory ) 1544 { 1545 for ( my $j = 1; $j <= 3; $j++ ) 1546 { 1547 if ( -d $directory ) 1548 { 1549 $infoline = "\n"; 1550 push(@installer::globals::logfileinfo, $infoline); 1551 $infoline = "Warning (Try $j): Problems with removing directory $directory\n"; 1552 push(@installer::globals::logfileinfo, $infoline); 1553 1554 $returnvalue = rmdir $directory; 1555 1556 if ( $returnvalue ) 1557 { 1558 $infoline = "Successfully removed empty dir $directory\n"; 1559 push(@installer::globals::logfileinfo, $infoline); 1560 } else { 1561 $infoline = "Warning: rmdir $directory failed.\n"; 1562 push(@installer::globals::logfileinfo, $infoline); 1563 } 1564 } 1565 } 1566 } 1567 } 1568} 1569 1570###################################################### 1571# Creating a unique directory with number extension 1572###################################################### 1573 1574sub create_unique_directory 1575{ 1576 my ($directory) = @_; 1577 1578 $directory =~ s/\Q$installer::globals::separator\E\s*$//; 1579 $directory = $directory . "_INCREASINGNUMBER"; 1580 1581 my $counter = 1; 1582 my $created = 0; 1583 my $localdirectory = ""; 1584 1585 do 1586 { 1587 $localdirectory = $directory; 1588 $localdirectory =~ s/INCREASINGNUMBER/$counter/; 1589 $counter++; 1590 1591 if ( ! -d $localdirectory ) 1592 { 1593 create_directory($localdirectory); 1594 $created = 1; 1595 } 1596 } 1597 while ( ! $created ); 1598 1599 return $localdirectory; 1600} 1601 1602###################################################### 1603# Creating a unique directory with pid extension 1604###################################################### 1605 1606sub create_pid_directory 1607{ 1608 my ($directory) = @_; 1609 1610 $directory =~ s/\Q$installer::globals::separator\E\s*$//; 1611 my $pid = $$; # process id 1612 my $time = time(); # time 1613 1614 $directory = $directory . "_" . $pid . $time; 1615 1616 if ( ! -d $directory ) { create_directory($directory); } 1617 else { installer::exiter::exit_program("ERROR: Directory $directory already exists!", "create_pid_directory"); } 1618 1619 return $directory; 1620} 1621 1622############################################################## 1623# Reading all files from a directory and its subdirectories 1624############################################################## 1625 1626sub read_complete_directory 1627{ 1628 my ($directory, $pathstring, $filecollector) = @_; 1629 1630 my @content = (); 1631 opendir(DIR, $directory); 1632 @content = readdir(DIR); 1633 closedir(DIR); 1634 1635 my $onefile; 1636 1637 foreach $onefile (@content) 1638 { 1639 if ((!($onefile eq ".")) && (!($onefile eq ".."))) 1640 { 1641 my $completefilename = $directory . $installer::globals::separator . $onefile; 1642 my $sep = ""; 1643 if ( $pathstring ne "" ) { $sep = $installer::globals::separator; } 1644 1645 if ( ! -d $completefilename ) # only files, no directories 1646 { 1647 my $content = $pathstring . $sep . $onefile; 1648 push(@{$filecollector}, $content); 1649 } 1650 else # recursive for directories 1651 { 1652 my $newpathstring = $pathstring . $sep . $onefile; 1653 read_complete_directory($completefilename, $newpathstring, $filecollector); 1654 } 1655 } 1656 } 1657} 1658 1659############################################################## 1660# Reading all files from a directory and its subdirectories 1661# Version 2 1662############################################################## 1663 1664sub read_full_directory { 1665 my ( $currentdir, $pathstring, $collector ) = @_; 1666 my $item; 1667 my $fullname; 1668 local *DH; 1669 1670 unless (opendir(DH, $currentdir)) 1671 { 1672 return; 1673 } 1674 while (defined ($item = readdir(DH))) 1675 { 1676 next if($item eq "." or $item eq ".."); 1677 $fullname = $currentdir . $installer::globals::separator . $item; 1678 my $sep = ""; 1679 if ( $pathstring ne "" ) { $sep = $installer::globals::separator; } 1680 1681 if( -d $fullname) 1682 { 1683 my $newpathstring = $pathstring . $sep . $item; 1684 read_full_directory($fullname, $newpathstring, $collector) if(-d $fullname); 1685 } 1686 else 1687 { 1688 my $content = $pathstring . $sep . $item; 1689 push(@{$collector}, $content); 1690 } 1691 } 1692 closedir(DH); 1693 return 1694} 1695 1696############################################################## 1697# Removing all empty directories below a specified directory 1698############################################################## 1699 1700sub remove_empty_dirs_in_folder 1701{ 1702 my ( $dir ) = @_; 1703 1704 my @content = (); 1705 my $infoline = ""; 1706 1707 $dir =~ s/\Q$installer::globals::separator\E\s*$//; 1708 1709 if ( -d $dir ) 1710 { 1711 opendir(DIR, $dir); 1712 @content = readdir(DIR); 1713 closedir(DIR); 1714 1715 my $oneitem; 1716 1717 foreach $oneitem (@content) 1718 { 1719 if ((!($oneitem eq ".")) && (!($oneitem eq ".."))) 1720 { 1721 my $item = $dir . $installer::globals::separator . $oneitem; 1722 1723 if ( -d $item ) # recursive 1724 { 1725 remove_empty_dirs_in_folder($item); 1726 } 1727 } 1728 } 1729 1730 # try to remove empty directory 1731 my $returnvalue = rmdir $dir; 1732 1733 if ( $returnvalue ) 1734 { 1735 $infoline = "Successfully removed empty dir $dir\n"; 1736 push(@installer::globals::logfileinfo, $infoline); 1737 } 1738 1739 } 1740 1741} 1742 17431; 1744