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 # 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 }