Koha/t/rewrite-config-test.PL
Lars Wirzenius 13af9b6195 Fix FSF address in directory t/
Signed-off-by: Galen Charlton <gmcharlt@gmail.com>
2010-03-16 20:17:51 -04:00

179 lines
4.1 KiB
Perl

# Copyright 2008 LibLime
#
# 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 2 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
#
use strict;
use warnings;
use Sys::Hostname;
use Socket;
use Getopt::Long;
use Pod::Usage;
use Data::Dumper;
# These variables get set from command line options
my ( $fname );
GetOptions( 'file=s', \$fname )
or pod2usage();
=head1 NAME
rewrite-test-config.PL - helper for the Koha packager and installer
=head1 SYNOPSIS
perl rewrite-test-config.PL configurationfile
=head1 DESCRIPTION
This helper script replaces keywords in the
configuration file with value either supplied through
the environment
I intend to make this part of hte normal make process eventually.
=head2 KEYWORDS
The following configuration keywords are available:
=head1 EXAMPLES
=cut
my $configfile = 'test-config.txt';
my $configuration = read_config_file( $configfile );
# Override configuration from the environment
foreach my $key (keys %$configuration) {
if (defined($ENV{$key})) {
$configuration->{$key} = $ENV{$key};
}
}
$configuration = add_underscores( $configuration );
my %configuration = replace_test_params( $configuration );
my $file = read_file($fname);
$file =~ s/__.*?__/exists $configuration{$&} ? $configuration{$&} : $&/seg;
# At this point, file is in 'blib' and by default
# has mode a-w. Therefore, must change permission
# to make it writable. Note that stat and chmod
# (the Perl functions) should work on Win32
my $old_perm;
$old_perm = (stat $fname)[2] & 07777;
my $new_perm = $old_perm | 0200;
chmod $new_perm, $fname;
open(OUTPUT,">$fname") || die "Can't open $fname for write: $!";
print OUTPUT $file;
close(OUTPUT);
chmod $old_perm, $fname;
=head2 read_config_file
takes the filename pointing to the configuration file that the
top-level Makefile wrote
returns a hashref that contains the configuration determined by
that file.
=cut
sub read_config_file {
my $config_file = shift;
if ( not -e $config_file ) {
die "unable to find configuration file: $config_file";
}
my $config;
if ( open( my $confighandle, '<', $config_file ) ) {
while ( my $line = <$confighandle> ) {
chomp $line;
next if ( $line eq '' );
next if ( $line =~ /^\s*#/ );
my ( $var, $value ) = split( /\s*=\s*/, $line );
$config->{ $var } = $value;
}
} else {
warn "unable to open configuration file: $config_file";
return;
}
return $config;
}
=head2 add_underscores
=cut
sub add_underscores {
my $config = shift;
my $newconfig;
foreach my $key ( keys %$config ) {
$newconfig->{ '__' . $key . '__' } = $config->{ $key };
}
return $newconfig;
}
=head2 replace_test_params
=cut
sub replace_test_params {
my $config = shift;
my $testconfig;
foreach my $key ( keys %$config ) {
if ( $key =~ /^__TEST_/ ) {
my $newkey = $key;
$newkey =~ s/^__TEST_/__/;
$testconfig->{ $newkey } = $config->{ $key };
}
}
# override variables with the "TEST_" variety.
my %newconfig = ( %$config, %$testconfig );
return %newconfig;
}
# Idea taken from perlfaq5
sub read_file {
local(*INPUT,$/);
open(INPUT,$_[0]) || die "Can't open $_[0] for read";
my $file = <INPUT>;
return $file;
}
__END__
=head1 SEE ALSO
Makefile.PL, ExtUtils::MakeMaker(3)
=head1 ACKNOWLEDGEMENTS
based on rewrite-config.PL by MJ Ray.
=head1 AUTHOR
Andrew Moore <andrew.moore@liblime.com>
=cut