xt/fix-old-fsf-address

   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 # This program is free software; you can redistribute it and/or modify
  16 # it under the terms of the GNU General Public License as published by
  17 # the Free Software Foundation; either version 2 of the License, or
  18 # (at your option) any later version.
  19 #
  20 # This program is distributed in the hope that it will be useful,
  21 # but 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 along
  26 # with this program; if not, write to the Free Software Foundation, Inc.,
  27 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  28
  29
  30 use strict;
  31 use warnings;
  32
  33 use File::Basename;
  34 use File::Copy;
  35 use File::Temp qw/ tempfile /;
  36
  37
  38 my $temple = << 'eof';
  39 You should have received a copy of the GNU General Public License along with
  40 Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  41 Suite 330, Boston, MA  02111-1307 USA
  42 eof
  43
  44 my $franklin = << 'eof';
  45 You should have received a copy of the GNU General Public License along
  46 with Koha; if not, write to the Free Software Foundation, Inc.,
  47 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  48 eof
  49
  50
  51 my $temple2 = << 'eof';
  52 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,
  53 Suite 330, Boston, MA  02111-1307 USA
  54 eof
  55
  56 my $franklin2 = << 'eof';
  57 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,
  58 Fifth Floor, Boston, MA 02110-1301 USA.
  59 eof
  60
  61
  62 my $temple3 = << 'eof';
  63 You should have received a copy of the GNU General Public License
  64 along with this program; if not, write to the Free Software
  65 Foundation, Inc., 50 Temple Place, Suite 330, Boston, MA 02111-1307  USA
  66 eof
  67
  68 my $franklin3 = << 'eof';
  69 You should have received a copy of the GNU General Public License
  70 along with this program; if not, write to the Free Software Foundation, Inc.,
  71 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  72 eof
  73
  74
  75 my $temple4 = << 'eof';
  76 You should have received a copy of the GNU General Public License
  77 along with Zebra; see the file LICENSE.zebra.  If not, write to the
  78 Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
  79 02111-1307, USA.
  80 eof
  81
  82 my $franklin4 = << 'eof';
  83 You should have received a copy of the GNU General Public License
  84 along with Zebra; see the file LICENSE.zebra.  If not, write to the
  85 Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,
  86 MA 02110-1301 USA.
  87 eof
  88
  89
  90 my @patterns = ($temple, $temple2, $temple3, $temple4);
  91 my @replacements = ($franklin, $franklin2, $franklin3, $franklin4);
  92
  93
  94 sub hashcomment {
  95     my ($str) = @_;
  96     my @lines = split /\n/, $str;
  97     my @result;
  98     foreach my $line (@lines) {
  99         push @result, "# $line\n";
 100     }
 101     return join "", @result
 102 }
 103
 104
 105 sub dashcomment {
 106     my ($str) = @_;
 107     my @lines = split /\n/, $str;
 108     my @result;
 109     foreach my $line (@lines) {
 110         push @result, "-- $line\n";
 111     }
 112     return join "", @result
 113 }
 114
 115
 116 sub readfile {
 117     my ($filename) = @_;
 118     open(FILE, $filename) || die("Can't open $filename for reading");
 119     my @lines;
 120     while (my $line = <FILE>) {
 121         push @lines, $line;
 122     }
 123     close(FILE);
 124     return join '', @lines;
 125 }
 126
 127
 128 sub try_to_fix {
 129     my ($data, @patterns) = @_;
 130     return undef;
 131 }
 132
 133
 134 sub overwrite {
 135     my ($filename, $data) = @_;
 136     my ($fh, $tempname) = tempfile(DIR => dirname($filename));
 137     print $fh $data;
 138     close($fh);
 139     copy($tempname, $filename);
 140     unlink($tempname);
 141 }
 142
 143
 144 sub fix_temple_street {
 145     my ($filename) = @_;
 146     my $data = readfile($filename);
 147     my @pats = map { ($_, hashcomment($_), dashcomment($_)) } @patterns;
 148     my @repls = map { ($_, hashcomment($_), dashcomment($_)) } @replacements;
 149     while (@pats) {
 150         my $pat = shift @pats;
 151         my $repl = shift @repls;
 152         my $index = index($data, $pat);
 153         next if $index == -1;
 154         my $length = length($pat);
 155         my $before = substr($data, 0, $index);
 156         my $after = substr($data, $index + $length);
 157         overwrite($filename, "$before$repl$after");
 158         return;
 159     }
 160     die("Cannot find old address in $filename");
 161 }
 162
 163
 164 while (my $filename = <>) {
 165     chomp $filename;
 166     fix_temple_street($filename);
 167 }