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

(-)a/xt/fix-old-fsf-address (-164 lines)
Lines 1-164 Link Here
1
#!/usr/bin/perl
2
#
3
# Fix GPLv2 license blurbs that have the old FSF address at Temple Street,
4
# instead of the Franklin Street one. Files to be fixed are read from
5
# stdin. Typical usage would be:
6
#
7
#   ./xt/find-license-problems . | 
8
#   grep -vFx -f ./xt/fix-old-fsf-address.exclude | 
9
#   ./xt/fix-old-fsf-address
10
#
11
# Copyright 2010 Catalyst IT Ltd
12
#
13
# This file is part of Koha.
14
#
15
# Koha is free software; you can redistribute it and/or modify it
16
# under the terms of the GNU General Public License as published by
17
# the Free Software Foundation; either version 3 of the License, or
18
# (at your option) any later version.
19
#
20
# Koha is distributed in the hope that it will be useful, but
21
# WITHOUT ANY WARRANTY; without even the implied warranty of
22
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23
# GNU General Public License for more details.
24
#
25
# You should have received a copy of the GNU General Public License
26
# along with Koha; if not, see <http://www.gnu.org/licenses>.
27
28
use Modern::Perl;
29
30
use File::Basename;
31
use File::Copy;
32
use File::Temp qw/ tempfile /;
33
34
35
my $temple = << 'eof';
36
You should have received a copy of the GNU General Public License along with
37
Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
38
Suite 330, Boston, MA  02111-1307 USA
39
eof
40
41
my $franklin = << 'eof';
42
You should have received a copy of the GNU General Public License along
43
with Koha; if not, write to the Free Software Foundation, Inc.,
44
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
45
eof
46
47
48
my $temple2 = << 'eof';
49
You should have received a copy of the GNU General Public License along with Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
50
Suite 330, Boston, MA  02111-1307 USA
51
eof
52
53
my $franklin2 = << 'eof';
54
You should have received a copy of the GNU General Public License along with Koha; if not, write to the Free Software Foundation, Inc., 51 Franklin Street,
55
Fifth Floor, Boston, MA 02110-1301 USA.
56
eof
57
58
59
my $temple3 = << 'eof';
60
You should have received a copy of the GNU General Public License
61
along with this program; if not, write to the Free Software
62
Foundation, Inc., 50 Temple Place, Suite 330, Boston, MA 02111-1307  USA
63
eof
64
65
my $franklin3 = << 'eof';
66
You should have received a copy of the GNU General Public License
67
along with this program; if not, write to the Free Software Foundation, Inc., 
68
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
69
eof
70
71
72
my $temple4 = << 'eof';
73
You should have received a copy of the GNU General Public License
74
along with Zebra; see the file LICENSE.zebra.  If not, write to the
75
Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
76
02111-1307, USA.
77
eof
78
79
my $franklin4 = << 'eof';
80
You should have received a copy of the GNU General Public License
81
along with Zebra; see the file LICENSE.zebra.  If not, write to the
82
Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, 
83
MA 02110-1301 USA.
84
eof
85
86
87
my @patterns = ($temple, $temple2, $temple3, $temple4);
88
my @replacements = ($franklin, $franklin2, $franklin3, $franklin4);
89
90
91
sub hashcomment {
92
    my ($str) = @_;
93
    my @lines = split /\n/, $str;
94
    my @result;
95
    foreach my $line (@lines) {
96
        push @result, "# $line\n";
97
    }
98
    return join "", @result
99
}
100
101
102
sub dashcomment {
103
    my ($str) = @_;
104
    my @lines = split /\n/, $str;
105
    my @result;
106
    foreach my $line (@lines) {
107
        push @result, "-- $line\n";
108
    }
109
    return join "", @result
110
}
111
112
113
sub readfile {
114
    my ($filename) = @_;
115
    open(my $fh, '<', $filename) || die("Can't open $filename for reading");
116
    my @lines;
117
    while (my $line = <$fh>) {
118
        push @lines, $line;
119
    }
120
    close($fh);
121
    return join '', @lines;
122
}
123
124
125
sub try_to_fix {
126
    my ($data, @patterns) = @_;
127
    return;
128
}
129
130
131
sub overwrite {
132
    my ($filename, $data) = @_;
133
    my ($fh, $tempname) = tempfile(DIR => dirname($filename));
134
    print $fh $data;
135
    close($fh);
136
    copy($tempname, $filename);
137
    unlink($tempname);
138
}
139
140
141
sub fix_temple_street {
142
    my ($filename) = @_;
143
    my $data = readfile($filename);
144
    my @pats = map { ($_, hashcomment($_), dashcomment($_)) } @patterns; 
145
    my @repls = map { ($_, hashcomment($_), dashcomment($_)) } @replacements;
146
    while (@pats) {
147
        my $pat = shift @pats;
148
        my $repl = shift @repls;
149
        my $index = index($data, $pat);
150
        next if $index == -1;
151
        my $length = length($pat);
152
        my $before = substr($data, 0, $index);
153
        my $after = substr($data, $index + $length);
154
        overwrite($filename, "$before$repl$after");
155
        return;
156
    }
157
    die("Cannot find old address in $filename");
158
}
159
160
161
while (my $filename = <>) {
162
    chomp $filename;
163
    fix_temple_street($filename);
164
}
(-)a/xt/fix-old-fsf-address.exclude (-7 lines)
Lines 1-6 Link Here
1
INSTALL.fedora7
2
misc/cronjobs/check-url.pl
3
misc/cronjobs/cloud-kw.pl
4
misc/installer_devel_notes/data/en/marcflavour/marc21/mandatory/marc21_framework_DEFAULT.sql
5
misc/installer_devel_notes/data/en/marcflavour/marc21/optional/marc21_simple_bib_frameworks.sql
6
koha-tmpl/
7
- 

Return to bug 26401