e1b4b53765
Test Case: Check the following files have been updated from use strict; use warnings; to use Modern::Perl; author/podcorrectness.t author/show-template-structure.pl author/translatable-templates.t author/valid-templates.t find-license-problems fix-old-fsf-address single_quotes.t verify-debian-docbook.t Signed-off-by: Jon Knight <J.P.Knight@lboro.ac.uk> Signed-off-by: Katrin Fischer <katrin.fischer.83@web.de> Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
166 lines
4.7 KiB
Perl
Executable file
166 lines
4.7 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
#
|
|
# Fix GPLv2 license blurbs that have the old FSF address at Temple Street,
|
|
# instead of the Franklin Street one. Files to be fixed are read from
|
|
# stdin. Typical usage would be:
|
|
#
|
|
# ./xt/find-license-problems . |
|
|
# grep -vFx -f ./xt/fix-old-fsf-address.exclude |
|
|
# ./xt/fix-old-fsf-address
|
|
#
|
|
# Copyright 2010 Catalyst IT Ltd
|
|
#
|
|
# This file is part of Koha.
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 2 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License along
|
|
# with this program; if not, write to the Free Software Foundation, Inc.,
|
|
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
|
|
|
|
use Modern::Perl;
|
|
|
|
use File::Basename;
|
|
use File::Copy;
|
|
use File::Temp qw/ tempfile /;
|
|
|
|
|
|
my $temple = << 'eof';
|
|
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,
|
|
Suite 330, Boston, MA 02111-1307 USA
|
|
eof
|
|
|
|
my $franklin = << 'eof';
|
|
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, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
eof
|
|
|
|
|
|
my $temple2 = << 'eof';
|
|
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,
|
|
Suite 330, Boston, MA 02111-1307 USA
|
|
eof
|
|
|
|
my $franklin2 = << 'eof';
|
|
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,
|
|
Fifth Floor, Boston, MA 02110-1301 USA.
|
|
eof
|
|
|
|
|
|
my $temple3 = << 'eof';
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 50 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
eof
|
|
|
|
my $franklin3 = << 'eof';
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software Foundation, Inc.,
|
|
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
eof
|
|
|
|
|
|
my $temple4 = << 'eof';
|
|
You should have received a copy of the GNU General Public License
|
|
along with Zebra; see the file LICENSE.zebra. If not, write to the
|
|
Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
|
|
02111-1307, USA.
|
|
eof
|
|
|
|
my $franklin4 = << 'eof';
|
|
You should have received a copy of the GNU General Public License
|
|
along with Zebra; see the file LICENSE.zebra. If not, write to the
|
|
Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,
|
|
MA 02110-1301 USA.
|
|
eof
|
|
|
|
|
|
my @patterns = ($temple, $temple2, $temple3, $temple4);
|
|
my @replacements = ($franklin, $franklin2, $franklin3, $franklin4);
|
|
|
|
|
|
sub hashcomment {
|
|
my ($str) = @_;
|
|
my @lines = split /\n/, $str;
|
|
my @result;
|
|
foreach my $line (@lines) {
|
|
push @result, "# $line\n";
|
|
}
|
|
return join "", @result
|
|
}
|
|
|
|
|
|
sub dashcomment {
|
|
my ($str) = @_;
|
|
my @lines = split /\n/, $str;
|
|
my @result;
|
|
foreach my $line (@lines) {
|
|
push @result, "-- $line\n";
|
|
}
|
|
return join "", @result
|
|
}
|
|
|
|
|
|
sub readfile {
|
|
my ($filename) = @_;
|
|
open(FILE, $filename) || die("Can't open $filename for reading");
|
|
my @lines;
|
|
while (my $line = <FILE>) {
|
|
push @lines, $line;
|
|
}
|
|
close(FILE);
|
|
return join '', @lines;
|
|
}
|
|
|
|
|
|
sub try_to_fix {
|
|
my ($data, @patterns) = @_;
|
|
return undef;
|
|
}
|
|
|
|
|
|
sub overwrite {
|
|
my ($filename, $data) = @_;
|
|
my ($fh, $tempname) = tempfile(DIR => dirname($filename));
|
|
print $fh $data;
|
|
close($fh);
|
|
copy($tempname, $filename);
|
|
unlink($tempname);
|
|
}
|
|
|
|
|
|
sub fix_temple_street {
|
|
my ($filename) = @_;
|
|
my $data = readfile($filename);
|
|
my @pats = map { ($_, hashcomment($_), dashcomment($_)) } @patterns;
|
|
my @repls = map { ($_, hashcomment($_), dashcomment($_)) } @replacements;
|
|
while (@pats) {
|
|
my $pat = shift @pats;
|
|
my $repl = shift @repls;
|
|
my $index = index($data, $pat);
|
|
next if $index == -1;
|
|
my $length = length($pat);
|
|
my $before = substr($data, 0, $index);
|
|
my $after = substr($data, $index + $length);
|
|
overwrite($filename, "$before$repl$after");
|
|
return;
|
|
}
|
|
die("Cannot find old address in $filename");
|
|
}
|
|
|
|
|
|
while (my $filename = <>) {
|
|
chomp $filename;
|
|
fix_temple_street($filename);
|
|
}
|