1 package install_misc::UpgradeBackup;
3 # Copyright (C) 2008 LibLime
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
21 use File::Compare qw(compare);
28 use vars qw(@ISA @EXPORT $VERSION);
31 @EXPORT = ('backup_changed_files');
36 install_misc::UpgradeBackup
40 This is a helper module used during a 'make upgrade' that
41 creates backups of files updated during an upgrade.
45 sub backup_changed_files {
49 my $inc_uninstall = shift;
52 foreach my $sourceroot (sort keys %$from_to) {
53 my $targetroot = $from_to->{$sourceroot};
54 my $currdir = File::Spec->catdir($cwd, $sourceroot);
56 next unless -d $currdir;
58 chdir $currdir or die "could not change to $currdir: $!";
65 my $targetdir = File::Spec->catdir($targetroot, $File::Find::dir);
66 my $targetfile = File::Spec->catfile($targetdir, $filename);
67 my $sourcedir = File::Spec->catdir($currdir, $File::Find::dir);
68 my $sourcefile = File::Spec->catfile($sourcedir, $filename);
71 my ($size) = (stat $sourcefile)[7];
72 my $backup = $targetfile . $suffix;
73 unless (-s $targetfile == $size and not compare($sourcefile, $targetfile)) {
74 print "Backed up $targetfile to $backup\n";
75 File::Copy::copy($targetfile, $backup);
84 Galen Charlton <galen.charlton@liblime.com>