Koha/xt/fix-old-fsf-address

#!/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);
}