1*c9b362f6SAndre Fischer#************************************************************** 2*c9b362f6SAndre Fischer# 3*c9b362f6SAndre Fischer# Licensed to the Apache Software Foundation (ASF) under one 4*c9b362f6SAndre Fischer# or more contributor license agreements. See the NOTICE file 5*c9b362f6SAndre Fischer# distributed with this work for additional information 6*c9b362f6SAndre Fischer# regarding copyright ownership. The ASF licenses this file 7*c9b362f6SAndre Fischer# to you under the Apache License, Version 2.0 (the 8*c9b362f6SAndre Fischer# "License"); you may not use this file except in compliance 9*c9b362f6SAndre Fischer# with the License. You may obtain a copy of the License at 10*c9b362f6SAndre Fischer# 11*c9b362f6SAndre Fischer# http://www.apache.org/licenses/LICENSE-2.0 12*c9b362f6SAndre Fischer# 13*c9b362f6SAndre Fischer# Unless required by applicable law or agreed to in writing, 14*c9b362f6SAndre Fischer# software distributed under the License is distributed on an 15*c9b362f6SAndre Fischer# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 16*c9b362f6SAndre Fischer# KIND, either express or implied. See the License for the 17*c9b362f6SAndre Fischer# specific language governing permissions and limitations 18*c9b362f6SAndre Fischer# under the License. 19*c9b362f6SAndre Fischer# 20*c9b362f6SAndre Fischer#************************************************************** 21*c9b362f6SAndre Fischer 22*c9b362f6SAndre Fischerpackage installer::patch::FileOperations; 23*c9b362f6SAndre Fischer 24*c9b362f6SAndre Fischeruse File::Basename; 25*c9b362f6SAndre Fischeruse File::Copy; 26*c9b362f6SAndre Fischeruse IO::Compress::Bzip2; 27*c9b362f6SAndre Fischeruse IO::Uncompress::Bunzip2; 28*c9b362f6SAndre Fischer 29*c9b362f6SAndre Fischermy $CompressionMethod = "bzip2"; 30*c9b362f6SAndre Fischer 31*c9b362f6SAndre Fischer 32*c9b362f6SAndre Fischer=head1 NAME 33*c9b362f6SAndre Fischer 34*c9b362f6SAndre Fischer package installer::patch::FileOperations - Class for collecting, checking and executing file operations. 35*c9b362f6SAndre Fischer 36*c9b362f6SAndre Fischer=cut 37*c9b362f6SAndre Fischer 38*c9b362f6SAndre Fischer 39*c9b362f6SAndre Fischersub new ($) 40*c9b362f6SAndre Fischer{ 41*c9b362f6SAndre Fischer my ($class) = (@_); 42*c9b362f6SAndre Fischer 43*c9b362f6SAndre Fischer my $self = { 44*c9b362f6SAndre Fischer 'operations' => [] 45*c9b362f6SAndre Fischer }; 46*c9b362f6SAndre Fischer bless($self, $class); 47*c9b362f6SAndre Fischer 48*c9b362f6SAndre Fischer return $self; 49*c9b362f6SAndre Fischer} 50*c9b362f6SAndre Fischer 51*c9b362f6SAndre Fischer 52*c9b362f6SAndre Fischer 53*c9b362f6SAndre Fischer 54*c9b362f6SAndre Fischersub AddCopyOperation ($$$) 55*c9b362f6SAndre Fischer{ 56*c9b362f6SAndre Fischer my ($self, $source_name, $target_name) = @_; 57*c9b362f6SAndre Fischer 58*c9b362f6SAndre Fischer push 59*c9b362f6SAndre Fischer @{$self->{'operations'}}, 60*c9b362f6SAndre Fischer [ 61*c9b362f6SAndre Fischer 'copy', 62*c9b362f6SAndre Fischer $source_name, 63*c9b362f6SAndre Fischer $target_name 64*c9b362f6SAndre Fischer ]; 65*c9b362f6SAndre Fischer} 66*c9b362f6SAndre Fischer 67*c9b362f6SAndre Fischer 68*c9b362f6SAndre Fischer 69*c9b362f6SAndre Fischer 70*c9b362f6SAndre Fischersub AddMakeDirectoryOperation ($$) 71*c9b362f6SAndre Fischer{ 72*c9b362f6SAndre Fischer my ($self, $path) = @_; 73*c9b362f6SAndre Fischer 74*c9b362f6SAndre Fischer push 75*c9b362f6SAndre Fischer @{$self->{'operations'}}, 76*c9b362f6SAndre Fischer [ 77*c9b362f6SAndre Fischer 'mkdir', 78*c9b362f6SAndre Fischer $path 79*c9b362f6SAndre Fischer ]; 80*c9b362f6SAndre Fischer} 81*c9b362f6SAndre Fischer 82*c9b362f6SAndre Fischer 83*c9b362f6SAndre Fischer 84*c9b362f6SAndre Fischer 85*c9b362f6SAndre Fischersub AddCompressOperation ($$) 86*c9b362f6SAndre Fischer{ 87*c9b362f6SAndre Fischer my ($self, $filename) = @_; 88*c9b362f6SAndre Fischer 89*c9b362f6SAndre Fischer push 90*c9b362f6SAndre Fischer @{$self->{'operations'}}, 91*c9b362f6SAndre Fischer [ 92*c9b362f6SAndre Fischer 'compress', 93*c9b362f6SAndre Fischer $filename 94*c9b362f6SAndre Fischer ]; 95*c9b362f6SAndre Fischer} 96*c9b362f6SAndre Fischer 97*c9b362f6SAndre Fischer 98*c9b362f6SAndre Fischer 99*c9b362f6SAndre Fischer 100*c9b362f6SAndre Fischersub AddUncompressOperation ($$$) 101*c9b362f6SAndre Fischer{ 102*c9b362f6SAndre Fischer my ($self, $source_name, $target_name) = @_; 103*c9b362f6SAndre Fischer 104*c9b362f6SAndre Fischer push 105*c9b362f6SAndre Fischer @{$self->{'operations'}}, 106*c9b362f6SAndre Fischer [ 107*c9b362f6SAndre Fischer 'uncompress', 108*c9b362f6SAndre Fischer $source_name, 109*c9b362f6SAndre Fischer $target_name 110*c9b362f6SAndre Fischer ]; 111*c9b362f6SAndre Fischer} 112*c9b362f6SAndre Fischer 113*c9b362f6SAndre Fischer 114*c9b362f6SAndre Fischer 115*c9b362f6SAndre Fischer 116*c9b362f6SAndre Fischersub Check ($) 117*c9b362f6SAndre Fischer{ 118*c9b362f6SAndre Fischer my ($self) = @_; 119*c9b362f6SAndre Fischer 120*c9b362f6SAndre Fischer # Keep track of which directories or files would be created to check if 121*c9b362f6SAndre Fischer # operations that depend on these files will succeed. 122*c9b362f6SAndre Fischer my %files = (); 123*c9b362f6SAndre Fischer my %directories = (); 124*c9b362f6SAndre Fischer 125*c9b362f6SAndre Fischer my @error_messages = (); 126*c9b362f6SAndre Fischer foreach my $operation (@{$self->{'operations'}}) 127*c9b362f6SAndre Fischer { 128*c9b362f6SAndre Fischer my $command = $operation->[0]; 129*c9b362f6SAndre Fischer 130*c9b362f6SAndre Fischer if ($command eq "copy") 131*c9b362f6SAndre Fischer { 132*c9b362f6SAndre Fischer my ($source_name, $destination_name) = ($operation->[1], $operation->[2]); 133*c9b362f6SAndre Fischer if ( ! -f $source_name) 134*c9b362f6SAndre Fischer { 135*c9b362f6SAndre Fischer push @error_messages, sprintf("%s is not a regular file and can not be copied", $source_name); 136*c9b362f6SAndre Fischer } 137*c9b362f6SAndre Fischer my $destination_path = dirname($destination_name); 138*c9b362f6SAndre Fischer if ( ! -d $destination_path && ! defined $directories{$destination_path}) 139*c9b362f6SAndre Fischer { 140*c9b362f6SAndre Fischer push @error_messages, sprintf("destination path %s does not exist", $destination_path); 141*c9b362f6SAndre Fischer } 142*c9b362f6SAndre Fischer if ( -f $destination_name) 143*c9b362f6SAndre Fischer { 144*c9b362f6SAndre Fischer # The destination file already exists. We have to overwrite it. 145*c9b362f6SAndre Fischer if ( ! -w $destination_name) 146*c9b362f6SAndre Fischer { 147*c9b362f6SAndre Fischer push @error_messges, sprintf("destination file %s exists but can not be overwritten", $destination_name); 148*c9b362f6SAndre Fischer } 149*c9b362f6SAndre Fischer } 150*c9b362f6SAndre Fischer $files{$destination_name} = 1; 151*c9b362f6SAndre Fischer } 152*c9b362f6SAndre Fischer elsif ($command eq "mkdir") 153*c9b362f6SAndre Fischer { 154*c9b362f6SAndre Fischer my $path = $operation->[1]; 155*c9b362f6SAndre Fischer if ( -d $path) 156*c9b362f6SAndre Fischer { 157*c9b362f6SAndre Fischer # Directory already exists. That is OK, the mkdir command will be silently ignored. 158*c9b362f6SAndre Fischer } 159*c9b362f6SAndre Fischer else 160*c9b362f6SAndre Fischer { 161*c9b362f6SAndre Fischer $directories{$path} = 1; 162*c9b362f6SAndre Fischer } 163*c9b362f6SAndre Fischer } 164*c9b362f6SAndre Fischer elsif ($command eq "compress") 165*c9b362f6SAndre Fischer { 166*c9b362f6SAndre Fischer my $filename = $operation->[1]; 167*c9b362f6SAndre Fischer if ( ! -f $filename && ! defined $files{$filename}) 168*c9b362f6SAndre Fischer { 169*c9b362f6SAndre Fischer # File does not exist and will not be created by an earlier operation. 170*c9b362f6SAndre Fischer push @error_messages, sprintf("file %s does not exist and can not be compressed", $filename); 171*c9b362f6SAndre Fischer } 172*c9b362f6SAndre Fischer } 173*c9b362f6SAndre Fischer elsif ($command eq "uncompress") 174*c9b362f6SAndre Fischer { 175*c9b362f6SAndre Fischer my ($source_filename, $destination_filename) = ($operation->[1], $operation->[2]); 176*c9b362f6SAndre Fischer if ($CompressionMethod eq "bzip2") 177*c9b362f6SAndre Fischer { 178*c9b362f6SAndre Fischer $source_filename .= ".bz2"; 179*c9b362f6SAndre Fischer } 180*c9b362f6SAndre Fischer if ( ! -f $source_filename && ! defined $files{$source_filename}) 181*c9b362f6SAndre Fischer { 182*c9b362f6SAndre Fischer # File does not exist and will not be created by an earlier operation. 183*c9b362f6SAndre Fischer push @error_messages, sprintf("file %s does not exist and can not be decompressed", $source_filename); 184*c9b362f6SAndre Fischer } 185*c9b362f6SAndre Fischer if ( -f $destination_filename && ! -w $destination_filename) 186*c9b362f6SAndre Fischer { 187*c9b362f6SAndre Fischer # Destination file aleady exists but can not be replaced. 188*c9b362f6SAndre Fischer push @error_messages, sprintf("compress destination file %s exists but can not be replaced", $destination_filename); 189*c9b362f6SAndre Fischer } 190*c9b362f6SAndre Fischer } 191*c9b362f6SAndre Fischer else 192*c9b362f6SAndre Fischer { 193*c9b362f6SAndre Fischer push @error_messages, sprintf("unknown operation %s", $command); 194*c9b362f6SAndre Fischer } 195*c9b362f6SAndre Fischer } 196*c9b362f6SAndre Fischer 197*c9b362f6SAndre Fischer return @error_messages; 198*c9b362f6SAndre Fischer} 199*c9b362f6SAndre Fischer 200*c9b362f6SAndre Fischer 201*c9b362f6SAndre Fischer 202*c9b362f6SAndre Fischer 203*c9b362f6SAndre Fischersub CheckAndExecute ($) 204*c9b362f6SAndre Fischer{ 205*c9b362f6SAndre Fischer my ($self) = @_; 206*c9b362f6SAndre Fischer 207*c9b362f6SAndre Fischer my @error_messages = $self->Check(); 208*c9b362f6SAndre Fischer if (scalar @error_messages > 0) 209*c9b362f6SAndre Fischer { 210*c9b362f6SAndre Fischer $installer::logger::Lang->printf("can not execute all operations:\n"); 211*c9b362f6SAndre Fischer for my $message (@error_messages) 212*c9b362f6SAndre Fischer { 213*c9b362f6SAndre Fischer $installer::logger::Lang->printf("ERROR: %s\n", $message); 214*c9b362f6SAndre Fischer } 215*c9b362f6SAndre Fischer return 0; 216*c9b362f6SAndre Fischer } 217*c9b362f6SAndre Fischer else 218*c9b362f6SAndre Fischer { 219*c9b362f6SAndre Fischer return $self->Execute(); 220*c9b362f6SAndre Fischer } 221*c9b362f6SAndre Fischer} 222*c9b362f6SAndre Fischer 223*c9b362f6SAndre Fischer 224*c9b362f6SAndre Fischer 225*c9b362f6SAndre Fischer 226*c9b362f6SAndre Fischersub Execute ($) 227*c9b362f6SAndre Fischer{ 228*c9b362f6SAndre Fischer my ($self) = @_; 229*c9b362f6SAndre Fischer 230*c9b362f6SAndre Fischer foreach my $operation (@{$self->{'operations'}}) 231*c9b362f6SAndre Fischer { 232*c9b362f6SAndre Fischer my $command = $operation->[0]; 233*c9b362f6SAndre Fischer 234*c9b362f6SAndre Fischer if ($command eq "copy") 235*c9b362f6SAndre Fischer { 236*c9b362f6SAndre Fischer my ($source_name, $destination_name) = ($operation->[1], $operation->[2]); 237*c9b362f6SAndre Fischer $installer::logger::Lang->printf("copy from %s\n to %s\n", $source_name, $destination_name); 238*c9b362f6SAndre Fischer if ( ! $DryRun) 239*c9b362f6SAndre Fischer { 240*c9b362f6SAndre Fischer my $result = copy($source_name, $destination_name); 241*c9b362f6SAndre Fischer if ( ! $result) 242*c9b362f6SAndre Fischer { 243*c9b362f6SAndre Fischer $installer::logger::Lang->printf("ERROR: copying from %s to %s failed", 244*c9b362f6SAndre Fischer $source_name, $destination_name); 245*c9b362f6SAndre Fischer } 246*c9b362f6SAndre Fischer } 247*c9b362f6SAndre Fischer } 248*c9b362f6SAndre Fischer elsif ($command eq "mkdir") 249*c9b362f6SAndre Fischer { 250*c9b362f6SAndre Fischer my $path = $operation->[1]; 251*c9b362f6SAndre Fischer if ( -d $path) 252*c9b362f6SAndre Fischer { 253*c9b362f6SAndre Fischer # Path exists already. Do nothing. 254*c9b362f6SAndre Fischer } 255*c9b362f6SAndre Fischer else 256*c9b362f6SAndre Fischer { 257*c9b362f6SAndre Fischer $installer::logger::Lang->printf("creating directory %s\n", $path); 258*c9b362f6SAndre Fischer if ( ! $DryRun) 259*c9b362f6SAndre Fischer { 260*c9b362f6SAndre Fischer if (File::Path::make_path($path, {'mode' => 0775}) == 0) 261*c9b362f6SAndre Fischer { 262*c9b362f6SAndre Fischer $installer::logger::Lang->printf("could not create directory %s\n", $path); 263*c9b362f6SAndre Fischer } 264*c9b362f6SAndre Fischer } 265*c9b362f6SAndre Fischer } 266*c9b362f6SAndre Fischer } 267*c9b362f6SAndre Fischer elsif ($command eq "compress") 268*c9b362f6SAndre Fischer { 269*c9b362f6SAndre Fischer my $filename = $operation->[1]; 270*c9b362f6SAndre Fischer $installer::logger::Lang->printf("compressing %s\n", $filename); 271*c9b362f6SAndre Fischer if ( ! $DryRun) 272*c9b362f6SAndre Fischer { 273*c9b362f6SAndre Fischer my $result = 0; 274*c9b362f6SAndre Fischer if ($CompressionMethod eq "bzip2") 275*c9b362f6SAndre Fischer { 276*c9b362f6SAndre Fischer $result = IO::Compress::Bzip2::bzip2($filename => $filename.".bz2"); 277*c9b362f6SAndre Fischer } 278*c9b362f6SAndre Fischer if ($result == 0) 279*c9b362f6SAndre Fischer { 280*c9b362f6SAndre Fischer $installer::logger::Lang->printf("ERROR: could not compress %s\n", $filename); 281*c9b362f6SAndre Fischer } 282*c9b362f6SAndre Fischer else 283*c9b362f6SAndre Fischer { 284*c9b362f6SAndre Fischer unlink($filename); 285*c9b362f6SAndre Fischer } 286*c9b362f6SAndre Fischer } 287*c9b362f6SAndre Fischer } 288*c9b362f6SAndre Fischer elsif ($command eq "uncompress") 289*c9b362f6SAndre Fischer { 290*c9b362f6SAndre Fischer my ($source_name, $destination_name) = ($operation->[1], $operation->[2]); 291*c9b362f6SAndre Fischer if ($CompressionMethod eq "bzip2") 292*c9b362f6SAndre Fischer { 293*c9b362f6SAndre Fischer $source_name .= ".bz2"; 294*c9b362f6SAndre Fischer } 295*c9b362f6SAndre Fischer $installer::logger::Lang->printf("uncompressing %s to %s\n", $source_name, $destination_name); 296*c9b362f6SAndre Fischer 297*c9b362f6SAndre Fischer my $destination_base_name = basename($destination_name); 298*c9b362f6SAndre Fischer 299*c9b362f6SAndre Fischer if ( ! $DryRun) 300*c9b362f6SAndre Fischer { 301*c9b362f6SAndre Fischer my $result = 0; 302*c9b362f6SAndre Fischer if ($CompressionMethod eq "bzip2") 303*c9b362f6SAndre Fischer { 304*c9b362f6SAndre Fischer $result = IO::Uncompress::Bunzip2::bunzip2($source_name => $destination_name); 305*c9b362f6SAndre Fischer } 306*c9b362f6SAndre Fischer if ($result == 0) 307*c9b362f6SAndre Fischer { 308*c9b362f6SAndre Fischer $installer::logger::Lang->printf("ERROR: failed to extract content of '%s' from '%s'\n", 309*c9b362f6SAndre Fischer $destination_name, $source_name); 310*c9b362f6SAndre Fischer return 0; 311*c9b362f6SAndre Fischer } 312*c9b362f6SAndre Fischer } 313*c9b362f6SAndre Fischer } 314*c9b362f6SAndre Fischer 315*c9b362f6SAndre Fischer else 316*c9b362f6SAndre Fischer { 317*c9b362f6SAndre Fischer die "unknown operation $command\n"; 318*c9b362f6SAndre Fischer } 319*c9b362f6SAndre Fischer } 320*c9b362f6SAndre Fischer 321*c9b362f6SAndre Fischer return 1; 322*c9b362f6SAndre Fischer} 323*c9b362f6SAndre Fischer 324*c9b362f6SAndre Fischer 325*c9b362f6SAndre Fischer 326*c9b362f6SAndre Fischersub GetOperationCount ($) 327*c9b362f6SAndre Fischer{ 328*c9b362f6SAndre Fischer my ($self) = @_; 329*c9b362f6SAndre Fischer return scalar @{$self->{'operations'}}; 330*c9b362f6SAndre Fischer} 331*c9b362f6SAndre Fischer 332*c9b362f6SAndre Fischer 333*c9b362f6SAndre Fischer1; 334