View | Details | Raw Unified | Return to bug 18373
Collapse All | Expand All

(-)a/C4/Installer/UpgradeBackup.pm (-1 / +94 lines)
Line 0 Link Here
0
- 
1
package C4::Installer::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
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
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 );
30
31
@ISA = ('Exporter');
32
@EXPORT = ('backup_changed_files');
33
34
=head1 NAME
35
36
C4::Installer::UpgradeBackup
37
38
=head1 DESCRIPTION
39
40
This is a helper module used during a 'make upgrade' that
41
creates backups of files updated during an upgrade.
42
43
=cut
44
45
sub backup_changed_files {
46
    my $from_to = shift;
47
    my $suffix = shift;
48
    my $verbose = shift;
49
    my $inc_uninstall = shift;
50
51
    my $cwd = cwd();
52
    foreach my $sourceroot (sort keys %$from_to) {
53
        my $targetroot = $from_to->{$sourceroot};
54
        my $currdir = File::Spec->catdir($cwd, $sourceroot);
55
56
        next unless -d $currdir;
57
58
        chdir $currdir or die "could not change to $currdir: $!";
59
       
60
        # expand path
61
        find(sub {
62
            return unless -f $_;
63
            my $filename = $_;
64
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);
69
70
            if (-f $targetfile) {
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);        
76
                }
77
            }
78
        }, ".");
79
    }
80
}
81
82
=head1 AUTHOR
83
84
Code based on parts of ExtUtils::Install in order to
85
approximately track how it identifies files to
86
install.
87
88
Koha Development Team <http://koha-community.org/>
89
90
Galen Charlton <galen.charlton@liblime.com>
91
92
=cut
93
94
1;

Return to bug 18373