solenv/bin/modules/installer/systemactions.pm

   1 #
   2 # This file is part of the LibreOffice project.
   3 #
   4 # This Source Code Form is subject to the terms of the Mozilla Public
   5 # License, v. 2.0. If a copy of the MPL was not distributed with this
   6 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
   7 #
   8 # This file incorporates work covered by the following license notice:
   9 #
  10 #   Licensed to the Apache Software Foundation (ASF) under one or more
  11 #   contributor license agreements. See the NOTICE file distributed
  12 #   with this work for additional information regarding copyright
  13 #   ownership. The ASF licenses this file to you under the Apache
  14 #   License, Version 2.0 (the "License"); you may not use this file
  15 #   except in compliance with the License. You may obtain a copy of
  16 #   the License at http://www.apache.org/licenses/LICENSE-2.0 .
  17 #
  18
  19 package installer::systemactions;
  20
  21 use strict;
  22 use warnings;
  23
  24 use Cwd;
  25 use File::Copy;
  26 use installer::converter;
  27 use installer::exiter;
  28 use installer::globals;
  29 use installer::pathanalyzer;
  30 use installer::remover;
  31 use installer::windows::msiglobal;
  32
  33 ######################################################
  34 # Creating a new directory
  35 ######################################################
  36
  37 sub create_directory
  38 {
  39     my ($directory) = @_;
  40
  41     create_directory_with_privileges( $directory, "755" );
  42 }
  43
  44 ######################################################
  45 # Creating a new directory with defined privileges
  46 ######################################################
  47
  48 sub create_directory_with_privileges
  49 {
  50     my ($directory, $privileges) = @_;
  51
  52     my $returnvalue = 1;
  53     my $infoline = "";
  54     my $localprivileges = oct("0".$privileges); # changes "777" to 0777
  55
  56     if (!(-d $directory))
  57     {
  58         $returnvalue = mkdir($directory, $localprivileges);
  59
  60         if ($returnvalue)
  61         {
  62             $infoline = "\nCreated directory: $directory\n";
  63             push(@installer::globals::logfileinfo, $infoline);
  64
  65             chmod $localprivileges, $directory;
  66         }
  67         else
  68         {
  69             # New solution in parallel packing: It is possible, that the directory now exists, although it
  70             # was not created in this process. There is only an important error, if the directory does not
  71             # exist now.
  72
  73             $infoline = "\nDid not succeed in creating directory: \"$directory\". Further attempts will follow.\n";
  74             push(@installer::globals::logfileinfo, $infoline);
  75
  76             if (!(-d $directory))
  77             {
  78                 # Problem with parallel packaging? -> Try a little harder, before exiting.
  79                 # Did someone else remove the parent directory in the meantime?
  80                 my $parentdir = $directory;
  81                 installer::pathanalyzer::get_path_from_fullqualifiedname(\$parentdir);
  82                 if (!(-d $parentdir))
  83                 {
  84                     $returnvalue = mkdir($directory, $localprivileges);
  85
  86                     if ($returnvalue)
  87                     {
  88                         $infoline = "\nAttention: Successfully created parent directory (should already be created before): $parentdir\n";
  89                         push(@installer::globals::logfileinfo, $infoline);
  90
  91                         chmod $localprivileges, $parentdir;
  92                     }
  93                     else
  94                     {
  95                         $infoline = "\nError: \"$directory\" could not be created. Even the parent directory \"$parentdir\" does not exist and could not be created.\n";
  96                         push(@installer::globals::logfileinfo, $infoline);
  97                         if ( -d $parentdir )
  98                         {
  99                             $infoline = "\nAttention: Finally the parent directory \"$parentdir\" exists, but I could not create it.\n";
 100                             push(@installer::globals::logfileinfo, $infoline);
 101                         }
 102                         else
 103                         {
 104                             # Now it is time to exit, even the parent could not be created.
 105                             installer::exiter::exit_program("ERROR: Could not create parent directory \"$parentdir\"", "create_directory_with_privileges");
 106                         }
 107                     }
 108                 }
 109
 110                 # At this point we have to assume, that the parent directory exist.
 111                 # Trying once more to create the desired directory
 112
 113                 $returnvalue = mkdir($directory, $localprivileges);
 114
 115                 if ($returnvalue)
 116                 {
 117                     $infoline = "\nAttention: Created directory \"$directory\" in the second try.\n";
 118                     push(@installer::globals::logfileinfo, $infoline);
 119
 120                     chmod $localprivileges, $directory;
 121                 }
 122                 else
 123                 {
 124                     if ( -d $directory )
 125                     {
 126                         $infoline = "\nAttention: Finally the directory \"$directory\" exists, but I could not create it.\n";
 127                         push(@installer::globals::logfileinfo, $infoline);
 128                     }
 129                     else
 130                     {
 131                         # It is time to exit, even the second try failed.
 132                         installer::exiter::exit_program("ERROR: Failed to create the directory: $directory", "create_directory_with_privileges");
 133                     }
 134                 }
 135             }
 136             else
 137             {
 138                 $infoline = "\nAnother process created this directory in exactly this moment :-) : $directory\n";
 139                 push(@installer::globals::logfileinfo, $infoline);
 140             }
 141         }
 142     }
 143     else
 144     {
 145         $infoline = "\nAlready existing directory, did not create: $directory\n";
 146         push(@installer::globals::logfileinfo, $infoline);
 147
 148         chmod $localprivileges, $directory;
 149     }
 150 }
 151
 152 #######################################################################
 153 # Calculating the number of languages in the string
 154 #######################################################################
 155
 156 sub get_number_of_langs
 157 {
 158     my ($languagestring) = @_;
 159
 160     my $number = 1;
 161
 162     my $workstring = $languagestring;
 163
 164     while ( $workstring =~ /^\s*(.*)_(.*?)\s*$/ )
 165     {
 166         $workstring = $1;
 167         $number++;
 168     }
 169
 170     return $number;
 171 }
 172
 173 #######################################################################
 174 # Creating the directories, in which files are generated or unzipped
 175 #######################################################################
 176
 177 sub create_directories
 178 {
 179     my ($newdirectory, $languagesref) =@_;
 180
 181     $installer::globals::unpackpath =~ s/\Q$installer::globals::separator\E\s*$//; # removing ending slashes and backslashes
 182
 183     my $path = "";
 184
 185     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
 186     {
 187         if ( $installer::globals::temppathdefined ) { $path = $installer::globals::temppath; }
 188         else { $path = $installer::globals::unpackpath; }
 189         $path =~ s/\Q$installer::globals::separator\E\s*$//; # removing ending slashes and backslashes
 190         $path = $path . $installer::globals::separator;
 191     }
 192     else
 193     {
 194         $path = $installer::globals::unpackpath . $installer::globals::separator;
 195
 196         # special handling, if LOCALINSTALLDIR is set
 197         if (( $installer::globals::localinstalldirset ) && ( $newdirectory eq "install" ))
 198         {
 199             $installer::globals::localinstalldir =~ s/\Q$installer::globals::separator\E\s*$//;
 200             $path = $installer::globals::localinstalldir . $installer::globals::separator;
 201         }
 202     }
 203
 204     my $infoline = "create_directories: Using $path for $newdirectory !\n";
 205     push( @installer::globals::logfileinfo, $infoline);
 206
 207     if ($newdirectory eq "unzip" ) # special handling for common directory
 208     {
 209     }
 210     else
 211     {
 212         my $localproductname = $installer::globals::product;
 213         my $localproductsubdir = "";
 214
 215         if ( $installer::globals::product =~ /^\s*(.+?)\_\_(.+?)\s*$/ )
 216         {
 217             $localproductname = $1;
 218             $localproductsubdir = $2;
 219         }
 220
 221         if ( $installer::globals::languagepack ) { $path = $path . $localproductname . "_languagepack" . $installer::globals::separator; }
 222         elsif ( $installer::globals::helppack ) { $path = $path . $localproductname . "_helppack" . $installer::globals::separator; }
 223         else { $path = $path . $localproductname . $installer::globals::separator; }
 224
 225         create_directory($path);
 226
 227         if ( $localproductsubdir )
 228         {
 229             $path = $path . $localproductsubdir . $installer::globals::separator;
 230             create_directory($path);
 231         }
 232
 233         $path = $path . $installer::globals::installertypedir . $installer::globals::separator;
 234         create_directory($path);
 235
 236         $path = $path . $newdirectory . $installer::globals::separator;
 237         create_directory($path);
 238
 239         my $locallanguagesref = "";
 240
 241         if ( $$languagesref ) { $locallanguagesref = $$languagesref; }
 242
 243         if ($newdirectory eq "install" && $installer::globals::ooodownloadfilename ne "" )
 244         {
 245             # put packages into versioned path; needed only on linux (fdo#30837)
 246             $path = $path . "$installer::globals::ooodownloadfilename" . $installer::globals::separator;
 247             create_directory($path);
 248         }
 249         else
 250         {
 251             if ($locallanguagesref ne "")   # this will be a path like "01_49", for Profiles and ConfigurationFiles, idt-Files
 252             {
 253
 254                 my $languagestring = $$languagesref;
 255
 256                 if (length($languagestring) > $installer::globals::max_lang_length )
 257                 {
 258                     my $number_of_languages = get_number_of_langs($languagestring);
 259                     #replace this in the same it was done in installer/windows/directory.pm
 260                     #chomp(my $shorter = `echo $languagestring | $ENV{'MD5SUM'} | sed -e "s/ .*//g"`);
 261                     #my $id = substr($shorter, 0, 8); # taking only the first 8 digits
 262                     my $id = installer::windows::msiglobal::calculate_id($languagestring, 8); # taking only the first 8 digits
 263                     $languagestring = "lang_" . $number_of_languages . "_id_" . $id;
 264                 }
 265
 266                 $path = $path . $languagestring . $installer::globals::separator;
 267                 create_directory($path);
 268             }
 269         }
 270     }
 271
 272     installer::remover::remove_ending_pathseparator(\$path);
 273
 274     $path = installer::converter::make_path_conform($path);
 275
 276     return $path;
 277 }
 278
 279 ########################
 280 # Copying one file
 281 ########################
 282
 283 sub is_empty_dir
 284 {
 285     my ($dir) = @_;
 286     my ($handle, $count);
 287     opendir($handle, $dir) or return 0;
 288     $count = scalar(grep { $_ ne '.' && $_ ne '..' } readdir($handle));
 289     closedir($handle);
 290     return $count == 0;
 291 }
 292
 293 sub copy_one_file
 294 {
 295     my ($source, $dest) = @_;
 296
 297     my ($returnvalue, $infoline, $copyreturn);
 298
 299     if ( -l $source ) {
 300         $copyreturn = symlink(readlink("$source"), "$dest");
 301     }
 302     elsif (-d $source && is_empty_dir($source)) {
 303         my $mode = (stat($source))[2] & 07777;
 304         $copyreturn = mkdir($dest, $mode);
 305     }
 306     else {
 307         $copyreturn = copy($source, $dest);
 308     }
 309
 310     if ($copyreturn)
 311     {
 312         $infoline = "Copy: $source to $dest\n";
 313         $returnvalue = 1;
 314     }
 315     else
 316     {
 317         $infoline = "ERROR: Could not copy $source to $dest $!\n";
 318         $returnvalue = 0;
 319     }
 320
 321     push(@installer::globals::logfileinfo, $infoline);
 322
 323     if ( !$returnvalue ) {
 324         return $returnvalue;
 325     }
 326
 327     # taking care of file attributes
 328     if ($installer::globals::iswin && -f $dest) {
 329         my $mode = -x $source ? 0775 : 0664;
 330         my $mode_str = sprintf("%o", $mode);
 331         my $chmodreturn = chmod($mode, $dest);
 332         if ($chmodreturn)
 333         {
 334             $infoline = "chmod $mode_str, $dest\n";
 335             $returnvalue = 1;
 336         }
 337         else
 338         {
 339             $infoline = "WARNING: Could not chmod $dest: $!\n";
 340             $returnvalue = 0;
 341         }
 342
 343         push(@installer::globals::logfileinfo, $infoline);
 344     }
 345
 346     return $returnvalue;
 347 }
 348
 349 ##########################
 350 # Hard linking one file
 351 ##########################
 352
 353 sub hardlink_one_file
 354 {
 355     my ($source, $dest) = @_;
 356
 357     my ($returnvalue, $infoline);
 358
 359     my $copyreturn = link($source, $dest);
 360
 361     if ($copyreturn)
 362     {
 363         $infoline = "Link: $source to $dest\n";
 364         $returnvalue = 1;
 365     }
 366     else
 367     {
 368         $infoline = "ERROR: Could not link $source to $dest\n";
 369         $returnvalue = 0;
 370     }
 371
 372     push(@installer::globals::logfileinfo, $infoline);
 373
 374     return $returnvalue;
 375 }
 376
 377 ##########################
 378 # Soft linking one file
 379 ##########################
 380
 381 sub softlink_one_file
 382 {
 383     my ($source, $dest) = @_;
 384
 385     my ($returnvalue, $infoline);
 386
 387     my $linkreturn = symlink($source, $dest);
 388
 389     if ($linkreturn)
 390     {
 391         $infoline = "Symlink: $source to $dest\n";
 392         $returnvalue = 1;
 393     }
 394     else
 395     {
 396         $infoline = "ERROR: Could not symlink $source to $dest\n";
 397         $returnvalue = 0;
 398     }
 399
 400     push(@installer::globals::logfileinfo, $infoline);
 401
 402     return $returnvalue;
 403 }
 404
 405 ########################
 406 # Renaming one file
 407 ########################
 408
 409 sub rename_one_file
 410 {
 411     my ($source, $dest) = @_;
 412
 413     my ($returnvalue, $infoline);
 414
 415     my $renamereturn = rename($source, $dest);
 416
 417     if ($renamereturn)
 418     {
 419         $infoline = "Rename: $source to $dest\n";
 420         $returnvalue = 1;
 421     }
 422     else
 423     {
 424         $infoline = "ERROR: Could not rename $source to $dest\n";
 425         $returnvalue = 0;
 426     }
 427
 428     push(@installer::globals::logfileinfo, $infoline);
 429
 430     return $returnvalue;
 431 }
 432
 433 ##########################################
 434 # Copying all files from one directory
 435 # to another directory
 436 ##########################################
 437
 438 sub copy_directory
 439 {
 440     my ($sourcedir, $destdir) = @_;
 441
 442     my @sourcefiles = ();
 443
 444     $sourcedir =~ s/\Q$installer::globals::separator\E\s*$//;
 445     $destdir =~ s/\Q$installer::globals::separator\E\s*$//;
 446
 447     my $infoline = "\n";
 448     push(@installer::globals::logfileinfo, $infoline);
 449     $infoline = "Copying files from directory $sourcedir to directory $destdir\n";
 450     push(@installer::globals::logfileinfo, $infoline);
 451
 452     opendir(DIR, $sourcedir);
 453     @sourcefiles = readdir(DIR);
 454     closedir(DIR);
 455
 456     my $onefile;
 457
 458     foreach $onefile (@sourcefiles)
 459     {
 460         if ((!($onefile eq ".")) && (!($onefile eq "..")))
 461         {
 462             my $sourcefile = $sourcedir . $installer::globals::separator . $onefile;
 463             my $destfile = $destdir . $installer::globals::separator . $onefile;
 464             if ( -f $sourcefile ) # only files, no directories
 465             {
 466                 copy_one_file($sourcefile, $destfile);
 467             }
 468         }
 469     }
 470 }
 471
 472 #####################################################################
 473 # Creating hard links to a complete directory with sub directories.
 474 #####################################################################
 475
 476 sub hardlink_complete_directory
 477 {
 478     my ($sourcedir, $destdir) = @_;
 479
 480     my @sourcefiles = ();
 481
 482     $sourcedir =~ s/\Q$installer::globals::separator\E\s*$//;
 483     $destdir =~ s/\Q$installer::globals::separator\E\s*$//;
 484
 485     if ( ! -d $destdir ) { create_directory($destdir); }
 486
 487     my $infoline = "\n";
 488     push(@installer::globals::logfileinfo, $infoline);
 489     $infoline = "Creating hard links for all files from directory $sourcedir to directory $destdir\n";
 490     push(@installer::globals::logfileinfo, $infoline);
 491
 492     opendir(DIR, $sourcedir);
 493     @sourcefiles = readdir(DIR);
 494     closedir(DIR);
 495
 496     my $onefile;
 497
 498     foreach $onefile (@sourcefiles)
 499     {
 500         if ((!($onefile eq ".")) && (!($onefile eq "..")))
 501         {
 502             my $source = $sourcedir . $installer::globals::separator . $onefile;
 503             my $dest = $destdir . $installer::globals::separator . $onefile;
 504             if ( -f $source ) # only files, no directories
 505             {
 506                 hardlink_one_file($source, $dest);
 507             }
 508             if ( -d $source ) # recursive
 509             {
 510                 hardlink_complete_directory($source, $dest);
 511             }
 512         }
 513     }
 514 }
 515
 516 #####################################################################
 517 # Creating hard links to a complete directory with sub directories.
 518 #####################################################################
 519
 520 sub softlink_complete_directory
 521 {
 522     my ($sourcedir, $destdir, $depth) = @_;
 523
 524     my @sourcefiles = ();
 525
 526     $sourcedir =~ s/\Q$installer::globals::separator\E\s*$//;
 527     $destdir =~ s/\Q$installer::globals::separator\E\s*$//;
 528
 529     if ( ! -d $destdir ) { create_directory($destdir); }
 530
 531     my $infoline = "\n";
 532     push(@installer::globals::logfileinfo, $infoline);
 533     $infoline = "Creating soft links for all files from directory $sourcedir to directory $destdir\n";
 534     push(@installer::globals::logfileinfo, $infoline);
 535
 536     opendir(DIR, $sourcedir);
 537     @sourcefiles = readdir(DIR);
 538     closedir(DIR);
 539
 540     my $onefile;
 541
 542     foreach $onefile (@sourcefiles)
 543     {
 544         if ((!($onefile eq ".")) && (!($onefile eq "..")))
 545         {
 546             my $source = $sourcedir . $installer::globals::separator . $onefile;
 547             my $dest = $destdir . $installer::globals::separator . $onefile;
 548             if ( -f $source ) # only files, no directories
 549             {
 550                 my $localsource = $source;
 551                 if ( $depth > 0 ) { for ( my $i = 1; $i <= $depth; $i++ ) { $localsource = "../" . $localsource; } }
 552                 softlink_one_file($localsource, $dest);
 553             }
 554             if ( -d $source ) # recursive
 555             {
 556                 my $newdepth = $depth + 1;
 557                 softlink_complete_directory($source, $dest, $newdepth);
 558             }
 559         }
 560     }
 561 }
 562
 563 #####################################################
 564 # Copying a complete directory with sub directories.
 565 #####################################################
 566
 567 sub copy_complete_directory
 568 {
 569     my ($sourcedir, $destdir) = @_;
 570
 571     my @sourcefiles = ();
 572
 573     $sourcedir =~ s/\Q$installer::globals::separator\E\s*$//;
 574     $destdir =~ s/\Q$installer::globals::separator\E\s*$//;
 575
 576     if ( ! -d $destdir ) { create_directory($destdir); }
 577
 578     my $infoline = "\n";
 579     push(@installer::globals::logfileinfo, $infoline);
 580     $infoline = "Copying files from directory $sourcedir to directory $destdir\n";
 581     push(@installer::globals::logfileinfo, $infoline);
 582
 583     opendir(DIR, $sourcedir);
 584     @sourcefiles = readdir(DIR);
 585     closedir(DIR);
 586
 587     my $onefile;
 588
 589     foreach $onefile (@sourcefiles)
 590     {
 591         if ((!($onefile eq ".")) && (!($onefile eq "..")))
 592         {
 593             my $source = $sourcedir . $installer::globals::separator . $onefile;
 594             my $dest = $destdir . $installer::globals::separator . $onefile;
 595             if ( -f $source ) # only files, no directories
 596             {
 597                 copy_one_file($source, $dest);
 598             }
 599             if ( -d $source ) # recursive
 600             {
 601                 if ((!( $source =~ /packages\/SUNW/ )) && (!( $source =~ /packages\/OOO/ ))) # do not copy complete Solaris packages!
 602                 {
 603                     copy_complete_directory($source, $dest);
 604                 }
 605             }
 606         }
 607     }
 608 }
 609
 610 #####################################################
 611 # Copying all files with a specified file extension
 612 # from one directory to another directory.
 613 #####################################################
 614
 615 sub copy_directory_with_fileextension
 616 {
 617     my ($sourcedir, $destdir, $extension) = @_;
 618
 619     my @sourcefiles = ();
 620
 621     $sourcedir =~ s/\Q$installer::globals::separator\E\s*$//;
 622     $destdir =~ s/\Q$installer::globals::separator\E\s*$//;
 623
 624     my $infoline = "\n";
 625     push(@installer::globals::logfileinfo, $infoline);
 626     $infoline = "Copying files with extension $extension from directory $sourcedir to directory $destdir\n";
 627     push(@installer::globals::logfileinfo, $infoline);
 628
 629     opendir(DIR, $sourcedir);
 630     @sourcefiles = readdir(DIR);
 631     closedir(DIR);
 632
 633     my $onefile;
 634
 635     foreach $onefile (@sourcefiles)
 636     {
 637         if ((!($onefile eq ".")) && (!($onefile eq "..")))
 638         {
 639             if ( $onefile =~ /\.$extension\s*$/ ) # only copying specified files
 640             {
 641                 my $sourcefile = $sourcedir . $installer::globals::separator . $onefile;
 642                 my $destfile = $destdir . $installer::globals::separator . $onefile;
 643                 if ( -f $sourcefile ) # only files, no directories
 644                 {
 645                     copy_one_file($sourcefile, $destfile);
 646                 }
 647             }
 648         }
 649     }
 650 }
 651
 652 ########################################################
 653 # Renaming all files with a specified file extension
 654 # in a specified directory.
 655 # Example: "Feature.idt.01" -> "Feature.idt"
 656 ########################################################
 657
 658 sub rename_files_with_fileextension
 659 {
 660     my ($dir, $extension) = @_;
 661
 662     my @sourcefiles = ();
 663
 664     $dir =~ s/\Q$installer::globals::separator\E\s*$//;
 665
 666     my $infoline = "\n";
 667     push(@installer::globals::logfileinfo, $infoline);
 668     $infoline = "Renaming files with extension \"$extension\" in the directory $dir\n";
 669     push(@installer::globals::logfileinfo, $infoline);
 670
 671     opendir(DIR, $dir);
 672     @sourcefiles = readdir(DIR);
 673     closedir(DIR);
 674
 675     my $onefile;
 676
 677     foreach $onefile (@sourcefiles)
 678     {
 679         if ((!($onefile eq ".")) && (!($onefile eq "..")))
 680         {
 681             if ( $onefile =~ /^\s*(\S.*?)\.$extension\s*$/ ) # only renaming specified files
 682             {
 683                 my $destfile = $1;
 684                 my $sourcefile = $dir . $installer::globals::separator . $onefile;
 685                 $destfile = $dir . $installer::globals::separator . $destfile;
 686                 if ( -f $sourcefile ) # only files, no directories
 687                 {
 688                     rename_one_file($sourcefile, $destfile);
 689                 }
 690             }
 691         }
 692     }
 693 }
 694
 695 ########################################################
 696 # Finding all files with a specified file extension
 697 # in a specified directory.
 698 ########################################################
 699
 700 sub find_file_with_file_extension
 701 {
 702     my ($extension, $dir) = @_;
 703
 704     my @allfiles = ();
 705
 706     $dir =~ s/\Q$installer::globals::separator\E\s*$//;
 707
 708     my $infoline = "\n";
 709     push(@installer::globals::logfileinfo, $infoline);
 710     $infoline = "Searching files with extension \"$extension\" in the directory $dir\n";
 711     push(@installer::globals::logfileinfo, $infoline);
 712
 713     opendir(DIR, $dir);
 714     my @sourcefiles = sort readdir(DIR);
 715     closedir(DIR);
 716
 717     my $onefile;
 718
 719     foreach $onefile (@sourcefiles)
 720     {
 721         if ((!($onefile eq ".")) && (!($onefile eq "..")))
 722         {
 723             if ( $onefile =~ /^\s*(\S.*?)\.$extension\s*$/ )
 724             {
 725                 push(@allfiles, $onefile)
 726             }
 727         }
 728     }
 729
 730     return \@allfiles;
 731 }
 732
 733 ##############################################################
 734 # Creating a unique directory, for example "01_inprogress_7"
 735 # in the install directory.
 736 ##############################################################
 737
 738 sub make_numbered_dir
 739 {
 740     my ($newstring, $olddir) = @_;
 741
 742     my $basedir = $olddir;
 743     installer::pathanalyzer::get_path_from_fullqualifiedname(\$basedir);
 744
 745     my $alldirs = get_all_directories($basedir);
 746
 747     # searching for the highest number extension
 748
 749     my $maxnumber = 0;
 750
 751     for ( my $i = 0; $i <= $#{$alldirs}; $i++ )
 752     {
 753         if ( ${$alldirs}[$i] =~ /\_(\d+)\s*$/ )
 754         {
 755             my $number = $1;
 756             if ( $number > $maxnumber ) { $maxnumber = $number; }
 757         }
 758     }
 759
 760     my $newnumber = $maxnumber + 1;
 761
 762     my $newdir = $olddir . "_" . $newstring . "_" . $newnumber;
 763
 764     my $returndir = "";
 765
 766     if ( move($olddir, $newdir) )
 767     {
 768         my $infoline = "\nMoved directory from $olddir to $newdir\n";
 769         push(@installer::globals::logfileinfo, $infoline);
 770         $returndir = $newdir;
 771     }
 772     else
 773     {
 774         my $infoline = "\nATTENTION: Could not move directory from $olddir to $newdir, \"make_numbered_dir\"\n";
 775         push(@installer::globals::logfileinfo, $infoline);
 776         $returndir = $olddir;
 777     }
 778
 779     return $returndir;
 780 }
 781
 782 #####################################################################################
 783 # Renaming a directory by exchanging a string, for example from "01_inprogress_7"
 784 # to "01_witherror_7".
 785 #####################################################################################
 786
 787 sub rename_string_in_directory
 788 {
 789     my ($olddir, $oldstring, $newstring) = @_;
 790
 791     my $newdir = $olddir;
 792     my $infoline = "";
 793
 794     $newdir =~ s/$oldstring/$newstring/g;
 795
 796     if (( -d $newdir ) && ( $olddir ne $newdir )) { remove_complete_directory($newdir, 1); }
 797
 798     if ( move($olddir, $newdir) )
 799     {
 800         $infoline = "\nMoved directory from $olddir to $newdir\n";
 801         push(@installer::globals::logfileinfo, $infoline);
 802     }
 803     else
 804     {
 805         $infoline = "\nATTENTION: Could not move directory from $olddir to $newdir, \"rename_string_in_directory\"\n";
 806         push(@installer::globals::logfileinfo, $infoline);
 807     }
 808
 809     return $newdir;
 810 }
 811
 812 ######################################################
 813 # Returning the complete directory name,
 814 # input is the first part of the directory name.
 815 ######################################################
 816
 817 sub get_directoryname
 818 {
 819     my ($searchdir, $startstring) = @_;
 820
 821     my $dirname = "";
 822     my $founddir = 0;
 823     my $direntry;
 824
 825     opendir(DIR, $searchdir);
 826
 827     foreach $direntry (readdir (DIR))
 828     {
 829         next if $direntry eq ".";
 830         next if $direntry eq "..";
 831
 832         if (( -d $direntry ) && ( $direntry =~ /^\s*\Q$startstring\E/ ))
 833         {
 834             $dirname = $direntry;
 835             $founddir = 1;
 836             last;
 837         }
 838     }
 839
 840     closedir(DIR);
 841
 842     if ( ! $founddir ) { installer::exiter::exit_program("ERROR: Did not find directory beginning with $startstring in directory $searchdir", "get_directoryname"); }
 843
 844     return $dirname;
 845 }
 846
 847
 848 ###################################
 849 # Renaming a directory
 850 ###################################
 851
 852 sub rename_directory
 853 {
 854     my ($olddir, $newdir) = @_;
 855
 856     my $infoline = "";
 857
 858     if ( move($olddir, $newdir) )
 859     {
 860         $infoline = "\nMoved directory from $olddir to $newdir\n";
 861         push(@installer::globals::logfileinfo, $infoline);
 862     }
 863     else
 864     {
 865         installer::exiter::exit_program("ERROR: Could not move directory from $olddir to $newdir $!", "rename_directory");
 866     }
 867
 868     return $newdir;
 869 }
 870
 871 ##############################################################
 872 # Creating a directory next to an existing directory
 873 ##############################################################
 874
 875 sub create_directory_next_to_directory
 876 {
 877     my ($topdir, $dirname) = @_;
 878
 879     my $basedir = $topdir;
 880     installer::pathanalyzer::get_path_from_fullqualifiedname(\$basedir);
 881
 882     $basedir =~ s/\Q$installer::globals::separator\E\s*$//;
 883
 884     my $newdir = $basedir . $installer::globals::separator . $dirname;
 885
 886     create_directory($newdir);
 887
 888     return $newdir;
 889 }
 890
 891 ##############################################################
 892 # Collecting all directories inside a directory
 893 ##############################################################
 894
 895 sub get_all_directories
 896 {
 897     my ($basedir) = @_;
 898
 899     my @alldirs = ();
 900     my $direntry;
 901
 902     $basedir =~ s/\Q$installer::globals::separator\E\s*$//;
 903
 904     opendir(DIR, $basedir);
 905
 906     foreach $direntry (readdir (DIR))
 907     {
 908         next if $direntry eq ".";
 909         next if $direntry eq "..";
 910
 911         my $completeentry = $basedir . $installer::globals::separator . $direntry;
 912
 913         if ( -d $completeentry ) { push(@alldirs, $completeentry); }
 914     }
 915
 916     closedir(DIR);
 917
 918     return \@alldirs;
 919 }
 920
 921 ##############################################################
 922 # Collecting all directories inside a directory
 923 # Returning without path
 924 ##############################################################
 925
 926 sub get_all_directories_without_path
 927 {
 928     my ($basedir) = @_;
 929
 930     my @alldirs = ();
 931     my $direntry;
 932
 933     $basedir =~ s/\Q$installer::globals::separator\E\s*$//;
 934
 935     opendir(DIR, $basedir);
 936
 937     foreach $direntry (readdir (DIR))
 938     {
 939         next if $direntry eq ".";
 940         next if $direntry eq "..";
 941
 942         my $completeentry = $basedir . $installer::globals::separator . $direntry;
 943
 944         if ( -d $completeentry ) { push(@alldirs, $direntry); }
 945     }
 946
 947     closedir(DIR);
 948
 949     return \@alldirs;
 950 }
 951
 952 ##############################################################
 953 # Collecting all files and directories inside one directory
 954 ##############################################################
 955
 956 sub read_directory
 957 {
 958     my ($basedir) = @_;
 959
 960     my @allcontent = ();
 961     my $direntry;
 962
 963     $basedir =~ s/\Q$installer::globals::separator\E\s*$//;
 964
 965     opendir(DIR, $basedir);
 966
 967     foreach $direntry (readdir (DIR))
 968     {
 969         next if $direntry eq ".";
 970         next if $direntry eq "..";
 971
 972         my $completeentry = $basedir . $installer::globals::separator . $direntry;
 973
 974         if (( -f $completeentry ) || ( -d $completeentry )) { push(@allcontent, $completeentry); }
 975     }
 976
 977     closedir(DIR);
 978
 979     return \@allcontent;
 980 }
 981
 982 ##############################################################
 983 # Finding the new content in a directory
 984 ##############################################################
 985
 986 sub find_new_content_in_directory
 987 {
 988     my ( $basedir, $oldcontent ) = @_;
 989
 990     my @newcontent = ();
 991     my @allcontent = ();
 992
 993     my $direntry;
 994
 995     $basedir =~ s/\Q$installer::globals::separator\E\s*$//;
 996
 997     opendir(DIR, $basedir);
 998
 999     foreach $direntry (readdir (DIR))
1000     {
1001         next if $direntry eq ".";
1002         next if $direntry eq "..";
1003
1004         my $completeentry = $basedir . $installer::globals::separator . $direntry;
1005
1006         if (( -f $completeentry ) || ( -d $completeentry ))
1007         {
1008             push(@allcontent, $completeentry);
1009             if (! grep {$_ eq $completeentry} @{$oldcontent})
1010             {
1011                 push(@newcontent, $completeentry);
1012             }
1013         }
1014     }
1015
1016     closedir(DIR);
1017
1018     return (\@newcontent, \@allcontent);
1019 }
1020
1021 ##############################################################
1022 # Trying to create a directory, no error if this fails
1023 ##############################################################
1024
1025 sub try_to_create_directory
1026 {
1027     my ($directory) = @_;
1028
1029     my $returnvalue = 1;
1030     my $created_directory = 0;
1031
1032     if (!(-d $directory))
1033     {
1034         $returnvalue = mkdir($directory, 0775);
1035
1036         if ($returnvalue)
1037         {
1038             $created_directory = 1;
1039             my $infoline = "\nCreated directory: $directory\n";
1040             push(@installer::globals::logfileinfo, $infoline);
1041
1042             chmod 0775, $directory;
1043         }
1044         else
1045         {
1046             $created_directory = 0;
1047         }
1048     }
1049     else
1050     {
1051         $created_directory = 1;
1052     }
1053
1054     return $created_directory;
1055 }
1056
1057 ##############################################################
1058 # Creating a complete directory structure
1059 ##############################################################
1060
1061 sub create_directory_structure
1062 {
1063     my ($directory) = @_;
1064
1065     if ( ! try_to_create_directory($directory) )
1066     {
1067         my $parentdir = $directory;
1068         installer::pathanalyzer::get_path_from_fullqualifiedname(\$parentdir);
1069
1070         my $infoline = "INFO: Did not create directory $directory\n";
1071         push(@installer::globals::logfileinfo, $infoline);
1072         $infoline = "Now trying to create parent directory $parentdir\n";
1073         push(@installer::globals::logfileinfo, $infoline);
1074
1075         create_directory_structure($parentdir); # recursive
1076     }
1077
1078     create_directory($directory); # now it has to succeed
1079 }
1080
1081 ######################################################
1082 # Removing a complete directory with subdirectories
1083 ######################################################
1084
1085 sub remove_complete_directory
1086 {
1087     my ($directory, $start) = @_;
1088
1089     my @content = ();
1090     my $infoline = "";
1091
1092     $directory =~ s/\Q$installer::globals::separator\E\s*$//;
1093
1094     if ( -d $directory )
1095     {
1096         if ( $start )
1097         {
1098             $infoline = "\n";
1099             push(@installer::globals::logfileinfo, $infoline);
1100             $infoline = "Removing directory $directory\n";
1101             push(@installer::globals::logfileinfo, $infoline);
1102         }
1103
1104         opendir(DIR, $directory);
1105         @content = readdir(DIR);
1106         closedir(DIR);
1107
1108         my $oneitem;
1109
1110         foreach $oneitem (@content)
1111         {
1112             if ((!($oneitem eq ".")) && (!($oneitem eq "..")))
1113             {
1114                 my $item = $directory . $installer::globals::separator . $oneitem;
1115
1116                 if ( -f $item || -l $item ) # deleting files or links
1117                 {
1118                     unlink($item);
1119                 }
1120
1121                 if ( -d $item ) # recursive
1122                 {
1123                     remove_complete_directory($item, 0);
1124                 }
1125             }
1126         }
1127
1128         # try to remove empty directory
1129
1130         my $returnvalue = rmdir $directory;
1131
1132         if ( ! $returnvalue )
1133         {
1134             $infoline = "Warning: Problem with removing empty dir $directory\n";
1135             push(@installer::globals::logfileinfo, $infoline);
1136         }
1137
1138         # try a little bit harder (sometimes there is a performance problem)
1139         if ( -d $directory )
1140         {
1141             for ( my $j = 1; $j <= 3; $j++ )
1142             {
1143                 if ( -d $directory )
1144                 {
1145                     $infoline = "\n";
1146                     push(@installer::globals::logfileinfo, $infoline);
1147                     $infoline = "Warning (Try $j): Problems with removing directory $directory\n";
1148                     push(@installer::globals::logfileinfo, $infoline);
1149
1150                     $returnvalue = rmdir $directory;
1151
1152                     if ( $returnvalue )
1153                     {
1154                         $infoline = "Successfully removed empty dir $directory\n";
1155                         push(@installer::globals::logfileinfo, $infoline);
1156                     } else {
1157                         $infoline = "Warning: rmdir $directory failed.\n";
1158                         push(@installer::globals::logfileinfo, $infoline);
1159                     }
1160                 }
1161             }
1162         }
1163     }
1164 }
1165
1166 ######################################################
1167 # Creating a unique directory with pid extension
1168 ######################################################
1169
1170 sub create_pid_directory
1171 {
1172     my ($directory) = @_;
1173
1174     $directory =~ s/\Q$installer::globals::separator\E\s*$//;
1175     my $pid = $$; # process id
1176     my $time = time(); # time
1177
1178     $directory = $directory . "_" . $pid . $time;
1179
1180     if ( ! -d $directory ) { create_directory($directory); }
1181     else { installer::exiter::exit_program("ERROR: Directory $directory already exists!", "create_pid_directory"); }
1182
1183     return $directory;
1184 }
1185
1186 ##############################################################
1187 # Reading all files from a directory and its subdirectories
1188 ##############################################################
1189
1190 sub read_complete_directory
1191 {
1192     my ($directory, $pathstring, $filecollector) = @_;
1193
1194     my @content = ();
1195     opendir(DIR, $directory);
1196     @content = readdir(DIR);
1197     closedir(DIR);
1198
1199     my $onefile;
1200
1201     foreach $onefile (@content)
1202     {
1203         if ((!($onefile eq ".")) && (!($onefile eq "..")))
1204         {
1205             my $completefilename = $directory . $installer::globals::separator . $onefile;
1206             my $sep = "";
1207             if ( $pathstring ne "" ) { $sep = $installer::globals::separator; }
1208
1209             if ( ! -d $completefilename ) # only files, no directories
1210             {
1211                 my $content = $pathstring . $sep . $onefile;
1212                 push(@{$filecollector}, $content);
1213             }
1214             else # recursive for directories
1215             {
1216                 my $newpathstring = $pathstring . $sep . $onefile;
1217                 read_complete_directory($completefilename, $newpathstring, $filecollector);
1218             }
1219         }
1220     }
1221 }
1222
1223 ##############################################################
1224 # Reading all files from a directory and its subdirectories
1225 # Version 2
1226 ##############################################################
1227
1228 sub read_full_directory {
1229     my ( $currentdir, $pathstring, $collector ) = @_;
1230     my $item;
1231     my $fullname;
1232     local *DH;
1233
1234     unless (opendir(DH, $currentdir))
1235     {
1236         return;
1237     }
1238     while (defined ($item = readdir(DH)))
1239     {
1240         next if($item eq "." or $item eq "..");
1241         $fullname = $currentdir . $installer::globals::separator . $item;
1242         my $sep = "";
1243         if ( $pathstring ne "" ) { $sep = $installer::globals::separator; }
1244
1245         if( -d $fullname)
1246         {
1247             my $newpathstring = $pathstring . $sep . $item;
1248             read_full_directory($fullname, $newpathstring, $collector) if(-d $fullname);
1249         }
1250         else
1251         {
1252             my $content = $pathstring . $sep . $item;
1253             push(@{$collector}, $content);
1254         }
1255     }
1256     closedir(DH);
1257     return
1258 }
1259
1260 ##############################################################
1261 # Removing all empty directories below a specified directory
1262 ##############################################################
1263
1264 sub remove_empty_dirs_in_folder
1265 {
1266     my ( $dir ) = @_;
1267
1268     my @content = ();
1269     my $infoline = "";
1270
1271     $dir =~ s/\Q$installer::globals::separator\E\s*$//;
1272
1273     if ( -d $dir )
1274     {
1275         opendir(DIR, $dir);
1276         @content = readdir(DIR);
1277         closedir(DIR);
1278
1279         my $oneitem;
1280
1281         foreach $oneitem (@content)
1282         {
1283             if ((!($oneitem eq ".")) && (!($oneitem eq "..")))
1284             {
1285                 my $item = $dir . $installer::globals::separator . $oneitem;
1286
1287                 if ( -d $item ) # recursive
1288                 {
1289                     remove_empty_dirs_in_folder($item);
1290                 }
1291             }
1292         }
1293
1294         # try to remove empty directory
1295         my $returnvalue = rmdir $dir;
1296
1297         if ( $returnvalue )
1298         {
1299             $infoline = "Successfully removed empty dir $dir\n";
1300             push(@installer::globals::logfileinfo, $infoline);
1301         }
1302
1303     }
1304
1305 }
1306
1307 ######################################################
1308 # Making systemcall
1309 ######################################################
1310
1311 sub make_systemcall
1312 {
1313     my ($systemcall) = @_;
1314
1315     my $returnvalue = system($systemcall);
1316
1317     my $infoline = "Systemcall: $systemcall\n";
1318     push( @installer::globals::logfileinfo, $infoline);
1319
1320     if ($returnvalue)
1321     {
1322         $infoline = "ERROR: Could not execute \"$systemcall\"!\n";
1323         push( @installer::globals::logfileinfo, $infoline);
1324     }
1325     else
1326     {
1327         $infoline = "Success: Executed \"$systemcall\" successfully!\n";
1328         push( @installer::globals::logfileinfo, $infoline);
1329     }
1330 }
1331
1332 1;