Koha/xt/fix-old-fsf-address
Galen Charlton 1aebed5dc8 move misc source file test and fix scripts to xt/
The license and non-UTF8 file checks are closer to
author tests and don't really belong at the top level of the
Koha source tree.  Follow-up might be to converted them
to test cases in xt/author that can be run by prove(1).

Signed-off-by: Galen Charlton <gmcharlt@gmail.com>
2010-05-06 19:46:51 -04:00

167 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 strict;
use warnings;
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);
}