solenv/bin/modules/pre2par/systemactions.pm

   1 #*************************************************************************
   2 #
   3 # DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   4 #
   5 # Copyright 2008 by Sun Microsystems, Inc.
   6 #
   7 # OpenOffice.org - a multi-platform office productivity suite
   8 #
   9 # $RCSfile: systemactions.pm,v $
  10 #
  11 # $Revision: 1.6 $
  12 #
  13 # This file is part of OpenOffice.org.
  14 #
  15 # OpenOffice.org is free software: you can redistribute it and/or modify
  16 # it under the terms of the GNU Lesser General Public License version 3
  17 # only, as published by the Free Software Foundation.
  18 #
  19 # OpenOffice.org is distributed in the hope that it will be useful,
  20 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 # GNU Lesser General Public License version 3 for more details
  23 # (a copy is included in the LICENSE file that accompanied this code).
  24 #
  25 # You should have received a copy of the GNU Lesser General Public License
  26 # version 3 along with OpenOffice.org.  If not, see
  27 # <http://www.openoffice.org/license.html>
  28 # for a copy of the LGPLv3 License.
  29 #
  30 #*************************************************************************
  31
  32
  33 package pre2par::systemactions;
  34
  35 use File::Copy;
  36 use pre2par::exiter;
  37 use pre2par::globals;
  38
  39 ######################################################
  40 # Creating a new direcotory
  41 ######################################################
  42
  43 sub create_directory
  44 {
  45     my ($directory) = @_;
  46
  47     my $returnvalue = 1;
  48     my $infoline = "";
  49
  50     if ($directory eq "" )
  51     {
  52         return 0;
  53     }
  54
  55     if (!(-d $directory))
  56     {
  57         $returnvalue = mkdir($directory, 0775);
  58
  59         if ($returnvalue)
  60         {
  61             $infoline = "Created directory: $directory\n";
  62             push(@pre2par::globals::logfileinfo, $infoline);
  63
  64             if ($pre2par::globals::isunix)
  65             {
  66                 my $localcall = "chmod 775 $directory \>\/dev\/null 2\>\&1";
  67                 system($localcall);
  68             }
  69         }
  70         else
  71         {
  72             # New solution in parallel packing: It is possible, that the directory now exists, although it
  73             # was not created in this process. There is only an important error, if the directory does not
  74             # exist now.
  75
  76             if (!(-d $directory))
  77             {
  78                 pre2par::exiter::exit_program("Error: Could not create directory: $directory", "create_directory");
  79             }
  80             else
  81             {
  82                 $infoline = "\nAnother process created this directory in exactly this moment :-) : $directory\n";
  83                 push(@pre2par::globals::logfileinfo, $infoline);
  84             }
  85         }
  86     }
  87     else
  88     {
  89         $infoline = "\nAlready existing directory, did not create: $directory\n";
  90         push(@pre2par::globals::logfileinfo, $infoline);
  91     }
  92 }
  93
  94 #######################################################################
  95 # Creating the directories, in which files are generated or unzipped
  96 #######################################################################
  97
  98 sub create_directories
  99 {
 100     my ($directory, $languagesref) =@_;
 101
 102     $pre2par::globals::unpackpath =~ s/\Q$pre2par::globals::separator\E\s*$//;  # removing ending slashes and backslashes
 103
 104     my $path = $pre2par::globals::unpackpath;    # this path already exists
 105
 106     $path = $path . $pre2par::globals::separator . $pre2par::globals::build . $pre2par::globals::separator;
 107     create_directory($path);
 108
 109     $path = $path . $pre2par::globals::minor . $pre2par::globals::separator;
 110     create_directory($path);
 111
 112     if ($directory eq "unzip" )
 113     {
 114         $path = $path . "common" . $pre2par::globals::productextension . $pre2par::globals::separator;
 115         create_directory($path);
 116
 117         $path = $path . $directory . $pre2par::globals::separator;
 118         create_directory($path);
 119     }
 120     else
 121     {
 122         $path = $path . $pre2par::globals::compiler . $pre2par::globals::productextension . $pre2par::globals::separator;
 123         create_directory($path);
 124
 125         $path = $path . $pre2par::globals::product . $pre2par::globals::separator;
 126         create_directory($path);
 127
 128         $path = $path . $directory . $pre2par::globals::separator;
 129         create_directory($path);
 130
 131         if (!($$languagesref eq "" ))   # this will be a path like "01_49", for Profiles and ConfigurationFiles, idt-Files
 132         {
 133             $path = $path . $$languagesref . $pre2par::globals::separator;
 134             create_directory($path);
 135         }
 136     }
 137
 138     $path =~ s/\Q$pre2par::globals::separator\E\s*$//;
 139
 140     return $path;
 141 }
 142
 143 ########################
 144 # Copying one file
 145 ########################
 146
 147 sub copy_one_file
 148 {
 149     my ($source, $dest) = @_;
 150
 151     my ($copyreturn, $returnvalue, $infoline);
 152
 153     $copyreturn = copy($source, $dest);
 154
 155     if ($copyreturn)
 156     {
 157         $infoline = "Copy: $source to $dest\n";
 158         $returnvalue = 1;
 159     }
 160     else
 161     {
 162         $infoline = "Error: Could not copy $source to $dest\n";
 163         $returnvalue = 0;
 164     }
 165
 166     push(@pre2par::globals::logfileinfo, $infoline);
 167
 168     return $returnvalue;
 169 }
 170
 171 ##########################################
 172 # Copying all files from one directory
 173 # to another directory
 174 ##########################################
 175
 176 sub copy_directory
 177 {
 178     my ($sourcedir, $destdir) = @_;
 179
 180     my ($onefile, $sourcefile, $destfile);
 181     my @sourcefiles = ();
 182
 183     $sourcedir =~ s/\Q$pre2par::globals::separator\E\s*$//;
 184     $destdir =~ s/\Q$pre2par::globals::separator\E\s*$//;
 185
 186     $infoline = "\n";
 187     push(@pre2par::globals::logfileinfo, $infoline);
 188     $infoline = "Copying files from directory $sourcedir to directory $destdir\n";
 189     push(@pre2par::globals::logfileinfo, $infoline);
 190
 191     opendir(DIR, $sourcedir);
 192     @sourcefiles = readdir(DIR);
 193     closedir(DIR);
 194
 195     foreach $onefile (@sourcefiles)
 196     {
 197         if ((!($onefile eq ".")) && (!($onefile eq "..")))
 198         {
 199             $sourcefile = $sourcedir . $pre2par::globals::separator . $onefile;
 200             $destfile = $destdir . $pre2par::globals::separator . $onefile;
 201             if ( -f $sourcefile )       # only files, no directories
 202             {
 203                 copy_one_file($sourcefile, $destfile);
 204             }
 205         }
 206     }
 207 }
 208
 209
 210 1;