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