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 24 25package pre2par::systemactions; 26 27use File::Copy; 28use pre2par::exiter; 29use pre2par::globals; 30 31###################################################### 32# Creating a new direcotory 33###################################################### 34 35sub create_directory 36{ 37 my ($directory) = @_; 38 39 my $returnvalue = 1; 40 my $infoline = ""; 41 42 if ($directory eq "" ) 43 { 44 return 0; 45 } 46 47 if (!(-d $directory)) 48 { 49 $returnvalue = mkdir($directory, 0775); 50 51 if ($returnvalue) 52 { 53 $infoline = "Created directory: $directory\n"; 54 push(@pre2par::globals::logfileinfo, $infoline); 55 56 if ($pre2par::globals::isunix) 57 { 58 my $localcall = "chmod 775 $directory \>\/dev\/null 2\>\&1"; 59 system($localcall); 60 } 61 } 62 else 63 { 64 # New solution in parallel packing: It is possible, that the directory now exists, although it 65 # was not created in this process. There is only an important error, if the directory does not 66 # exist now. 67 68 if (!(-d $directory)) 69 { 70 pre2par::exiter::exit_program("Error: Could not create directory: $directory", "create_directory"); 71 } 72 else 73 { 74 $infoline = "\nAnother process created this directory in exactly this moment :-) : $directory\n"; 75 push(@pre2par::globals::logfileinfo, $infoline); 76 } 77 } 78 } 79 else 80 { 81 $infoline = "\nAlready existing directory, did not create: $directory\n"; 82 push(@pre2par::globals::logfileinfo, $infoline); 83 } 84} 85 86####################################################################### 87# Creating the directories, in which files are generated or unzipped 88####################################################################### 89 90sub create_directories 91{ 92 my ($directory, $languagesref) =@_; 93 94 $pre2par::globals::unpackpath =~ s/\Q$pre2par::globals::separator\E\s*$//; # removing ending slashes and backslashes 95 96 my $path = $pre2par::globals::unpackpath; # this path already exists 97 98 $path = $path . $pre2par::globals::separator . $pre2par::globals::build . $pre2par::globals::separator; 99 create_directory($path); 100 101 $path = $path . $pre2par::globals::minor . $pre2par::globals::separator; 102 create_directory($path); 103 104 if ($directory eq "unzip" ) 105 { 106 $path = $path . "common" . $pre2par::globals::productextension . $pre2par::globals::separator; 107 create_directory($path); 108 109 $path = $path . $directory . $pre2par::globals::separator; 110 create_directory($path); 111 } 112 else 113 { 114 $path = $path . $pre2par::globals::compiler . $pre2par::globals::productextension . $pre2par::globals::separator; 115 create_directory($path); 116 117 $path = $path . $pre2par::globals::product . $pre2par::globals::separator; 118 create_directory($path); 119 120 $path = $path . $directory . $pre2par::globals::separator; 121 create_directory($path); 122 123 if (!($$languagesref eq "" )) # this will be a path like "01_49", for Profiles and ConfigurationFiles, idt-Files 124 { 125 $path = $path . $$languagesref . $pre2par::globals::separator; 126 create_directory($path); 127 } 128 } 129 130 $path =~ s/\Q$pre2par::globals::separator\E\s*$//; 131 132 return $path; 133} 134 135######################## 136# Copying one file 137######################## 138 139sub copy_one_file 140{ 141 my ($source, $dest) = @_; 142 143 my ($copyreturn, $returnvalue, $infoline); 144 145 $copyreturn = copy($source, $dest); 146 147 if ($copyreturn) 148 { 149 $infoline = "Copy: $source to $dest\n"; 150 $returnvalue = 1; 151 } 152 else 153 { 154 $infoline = "Error: Could not copy $source to $dest\n"; 155 $returnvalue = 0; 156 } 157 158 push(@pre2par::globals::logfileinfo, $infoline); 159 160 return $returnvalue; 161} 162 163########################################## 164# Copying all files from one directory 165# to another directory 166########################################## 167 168sub copy_directory 169{ 170 my ($sourcedir, $destdir) = @_; 171 172 my ($onefile, $sourcefile, $destfile); 173 my @sourcefiles = (); 174 175 $sourcedir =~ s/\Q$pre2par::globals::separator\E\s*$//; 176 $destdir =~ s/\Q$pre2par::globals::separator\E\s*$//; 177 178 $infoline = "\n"; 179 push(@pre2par::globals::logfileinfo, $infoline); 180 $infoline = "Copying files from directory $sourcedir to directory $destdir\n"; 181 push(@pre2par::globals::logfileinfo, $infoline); 182 183 opendir(DIR, $sourcedir); 184 @sourcefiles = readdir(DIR); 185 closedir(DIR); 186 187 foreach $onefile (@sourcefiles) 188 { 189 if ((!($onefile eq ".")) && (!($onefile eq ".."))) 190 { 191 $sourcefile = $sourcedir . $pre2par::globals::separator . $onefile; 192 $destfile = $destdir . $pre2par::globals::separator . $onefile; 193 if ( -f $sourcefile ) # only files, no directories 194 { 195 copy_one_file($sourcefile, $destfile); 196 } 197 } 198 } 199} 200 201 2021; 203