Bug 5370: Fix all the references to koha.org
[wip/koha-chris_n.git] / install_misc / UpgradeBackup.pm
1 package install_misc::UpgradeBackup;
2
3 # Copyright (C) 2008 LibLime
4 #
5 # This file is part of Koha.
6 #
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
10 # version.
11 #
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.
15 #
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20 use strict;
21 #use warnings; FIXME - Bug 2505
22 use File::Compare qw(compare);
23 use Cwd qw(cwd);
24 use File::Copy;
25 use File::Find;
26 use File::Spec;
27 use Exporter;
28
29 use vars qw(@ISA @EXPORT $VERSION);
30
31 @ISA = ('Exporter');
32 @EXPORT = ('backup_changed_files');
33 $VERSION = '3.00';
34
35 =head1 NAME
36
37 install_misc::UpgradeBackup
38
39 =head1 DESCRIPTION
40
41 This is a helper module used during a 'make upgrade' that
42 creates backups of files updated during an upgrade.
43
44 =cut
45
46 sub backup_changed_files {
47     my $from_to = shift;
48     my $suffix = shift;
49     my $verbose = shift;
50     my $inc_uninstall = shift;
51
52     my $cwd = cwd();
53     foreach my $sourceroot (sort keys %$from_to) {
54         my $targetroot = $from_to->{$sourceroot};
55         my $currdir = File::Spec->catdir($cwd, $sourceroot);
56
57         next unless -d $currdir;
58
59         chdir $currdir or die "could not change to $currdir: $!";
60        
61         # expand path
62         find(sub {
63             return unless -f $_;
64             my $filename = $_;
65
66             my $targetdir  = File::Spec->catdir($targetroot, $File::Find::dir);
67             my $targetfile = File::Spec->catfile($targetdir, $filename);
68             my $sourcedir  = File::Spec->catdir($currdir, $File::Find::dir);
69             my $sourcefile = File::Spec->catfile($sourcedir, $filename);
70
71             if (-f $targetfile) {
72                 my ($size) = (stat $sourcefile)[7];
73                 my $backup = $targetfile . $suffix;
74                 unless (-s $targetfile == $size and not compare($sourcefile, $targetfile)) {
75                     print "Backed up $targetfile to $backup\n";
76                     File::Copy::copy($targetfile, $backup);        
77                 }
78             }
79         }, ".");
80     }
81 }
82
83 =head1 AUTHOR
84
85 Code based on parts of ExtUtils::Install in order to
86 approximately track how it identifies files to
87 install.
88
89 Koha Development Team <http://koha-community.org/>
90
91 Galen Charlton <galen.charlton@liblime.com>
92
93 =cut
94
95 1;