Koha/xt/fix-old-fsf-address
Julian Maurice b168f4a2e9 Bug 21395: Make perlcritic happy
This patch adds a .perlcriticrc (copied from qa-test-tools) and fixes
almost all perlcrictic violations according to this .perlcriticrc
The remaining violations are silenced out by appending a '## no critic'
to the offending lines. They can still be seen by using the --force
option of perlcritic
This patch also modify t/00-testcritic.t to check all Perl files using
the new .perlcriticrc.
I'm not sure if this test script is still useful as it is now equivalent
to `perlcritic --quiet .` and it looks like it is much slower
(approximatively 5 times slower on my machine)

Test plan:
1. Run `perlcritic --quiet .` from the root directory. It should output
   nothing
2. Run `perlcritic --quiet --force .`. It should output 7 errors (6
   StringyEval, 1 BarewordFileHandles)
3. Run `TEST_QA=1 prove t/00-testcritic.t`
4. Read the patch. Check that all changes make sense and do not
   introduce undesired behaviour

Signed-off-by: Bernardo Gonzalez Kriegel <bgkriegel@gmail.com>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
2020-06-29 12:37:02 +02:00

164 lines
4.6 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.
#
# Koha 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 3 of the License, or
# (at your option) any later version.
#
# Koha 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 Koha; if not, see <http://www.gnu.org/licenses>.
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(my $fh, '<', $filename) || die("Can't open $filename for reading");
my @lines;
while (my $line = <$fh>) {
push @lines, $line;
}
close($fh);
return join '', @lines;
}
sub try_to_fix {
my ($data, @patterns) = @_;
return;
}
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);
}